home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 095 / 151b_src.arc / RBBS-PC.BAS < prev    next >
BASIC Source File  |  1987-06-07  |  205KB  |  5,729 lines
  1. 3 ' $linesize: 132
  2. 4 ' $title: 'RBBS CPC15-1A, Copyright 1987 by D. Thomas Mack'
  3. 5 ' WARNING !!! DO NOT CHANGE, BYPASS OR REMOVE LINES 3-31
  4. 9 'by D. Thomas Mack, 10210 Oxfordshire Road, Great Falls, VA 22066
  5. 10 '  Jon J. Martin, 4396 N. Prairie Willow Ct., Concord, CA 94521
  6. 11 '  Ken Goosens, 5020 Portsmouth Road, Fairfax, VA 22032
  7. 13 '
  8. 14 ' *******************************NOTICE*************************************
  9. 15 ' *  A limited license is granted to all users of this program and it's    *
  10. 16 ' *  companion program, CONFIG (version 3.00), to make copies of this      *
  11. 17 ' *  program and distribute the copies to other users, on the following    *
  12. 18 ' *  conditions:                                                           *
  13. 19 ' *    1.   The notices contained in lines 3 through 59 of the program     *
  14. 20 ' *         are not altered, bypassed, or removed.                         *
  15. 21 ' *    2.   The program is not to be distributed to others in modified     *
  16. 22 ' *         form (i.e. the line numbers must remain the same).             *
  17. 23 ' *    3.   No fee is to be charged (or any other consideration received)  *
  18. 24 ' *         for copying or distributing these programs without an express  *
  19. 25 ' *         written agreement with D. Thomas Mack, The Second Ring, 10210  *
  20. 26 ' *         Oxfordshire Road, Great falls, Virginia 22006                  *
  21. 27 ' *                                                                        *
  22. 28 ' *       Copyright (c) 1983-1987 D. Thomas Mack, The Second Ring          *
  23. 29 ' **************************************************************************
  24.    '
  25.    ' $INCLUDE: 'RBBS-VAR.BAS'
  26.    '
  27.    ' $SUBTITLE: 'Main-line RBBS-PC Program'
  28.     J = 54
  29.     REDIM OPT.SEC(J)
  30.     CONFIG.FILENAME$ = "RBBS-PC.DEF"
  31.     CALL GETCOMND (DEBUG,NETIME$,NETBAUD$)                           ' CPC15-1B
  32.     SUBROUTINE.PARAMETER = -62
  33.     CALL READDEF
  34.     CALL MLINIT (1)
  35.     IF RECYCLE.TO.DOS OR _
  36.        DEBUG OR _
  37.        EXIT.TO.DOORS THEN _
  38.        GOTO 100
  39.     SUBROUTINE.PARAMETER = - 9
  40.     CALL CARRIER
  41.     IF SUBROUTINE.PARAMETER THEN _
  42.        CALL COPYWRIT
  43. 100 CLEAR:'                                               Erase all variables
  44.     ON ERROR GOTO 13000:'                                 Set ERROR trap
  45.     DEF SEG:'                                             Point to BASIC
  46.     WIDTH 80:'                                            Set Screen Width
  47.     SCREEN 0,0,0:'                                        Text, No color, Pg 0
  48.     KEY OFF:'                                             Line 25 turned off
  49.     DEFINT A-Z:'                                          All var. integer
  50. ' ********************* Variable Definitions ********************************
  51. 102 ADIM = 99
  52.     MM = 999
  53.     BX = 50
  54.     J = 54
  55.     REDIM OPT.SEC(J)
  56.     REDIM CATEGORY.NAME$(BX),CATEGORY.CODE$(BX),CATEGORY.DESC$(BX)
  57.     REDIM A$(ADIM)                      ' Message line table
  58.     REDIM B$(ADIM)                      ' Message line table
  59.     REDIM M(MM,2)                       ' Message pointers
  60. 104 ACKNOWLEDGE$ = CHR$(6)
  61.     ACTIVE.MENU$ = "B"
  62.     ACTIVE.MESSAGE$=CHR$(225)
  63.     BACKSPACE$ = CHR$(8) + CHR$(32) + CHR$(8)
  64.     BACK.ARROW$ = CHR$(29) + CHR$(32) + CHR$(29)
  65.     C.L = 24
  66.     CANCEL$ = CHR$(24)
  67.     COLOR.RESET$=CHR$(27)+"[00;37;40m"
  68.     CONFIG.FILENAME$ = "RBBS-PC.DEF"
  69.     CARRIAGE.RETURN$ = CHR$(13)
  70.     DELETED.MESSAGE$=CHR$(226)
  71.     END.TRANSMISSION$ = CHR$(4)
  72.     ESCAPE$ = CHR$(27)
  73.     EXPECT.ACTIVE.MODEM = 0                                          ' CPC15-1B
  74.     FALSE = 0
  75.     F1.KEY = 59
  76.     F10.KEY = 68
  77.     GRN$ = "MAIN"
  78.     LIMIT.MINUTES.PER.SESSION! = 0                                   ' CPC15-1B
  79.     LINE.FEED$ = CHR$(10)
  80.     LINE.FEEDS = NOT FALSE
  81.     LINEEDIT.CHK$ = CHR$(9)+LINE.FEED$+CHR$(11)+CHR$(12)+CHR$(127)+CHR$(8)+CHR$(7)+CHR$(26)+CHR$(227)
  82.     LINEMES$ = SPACE$(74)              ' fixed length string workspace
  83.     LOCK.STATUS$ = "UM UU UB UD"
  84.     NEGATIVE.ACKNOWLEDGE$ = CHR$(21)
  85.     NO.ADVANCE = FALSE
  86.     PRESS.ENTER$ = " (Press [ENTER] to quit)"
  87.     PRIVATE.DOOR = FALSE
  88.     RIGHT.MARGIN = 72
  89.     RETURN.LINE.FEED$ = CARRIAGE.RETURN$ + LINE.FEED$
  90.     START.OF.HEADER$ = CHR$(1)
  91.     TIME.LOGGED.ON$ = SPACE$(8)
  92.     TRANSFER.OPTIONS$= _
  93.      "A)scii, X)modem, C)Xmodem/CRC, " + _
  94.      RETURN.LINE.FEED$ + _
  95.      "K)ermit, Y)modem, I)modem, G)ymodemG, W)xmodem, N)one"
  96.     TRUE = NOT FALSE
  97.     USER.DATA = FALSE
  98. 105 VERSION.ID$ = "CPC15.1B"                                         ' CPC15-1B
  99.     XOFF$ = CHR$(19)
  100.     XON$ = CHR$(17)
  101.   ' ******************** Logon Error Message Table ****************************
  102. 106 LG$(1) = "Registration Check Failed"
  103.     LG$(2) = "Sysop name attempted"
  104.     LG$(3) = "Locked out attempt"
  105.     LG$(4) = "Password Attempt Failed"
  106.     LG$(5) = "Auto Lockout done"
  107.     LG$(6) = "Name in use on another Node!"
  108.     LG$(7) = "300 Baud access not allowed!"
  109.     LG$(8) = "Locked reason read!"
  110.     LG$(9) = "Expired Subscription"
  111.     CALL GETCOMND (DEBUG,NETIME$,NETBAUD$)                           ' CPC15-1B
  112.     SUBROUTINE.PARAMETER = 1
  113.     CALL READDEF
  114.     IF NET.MAIL$ <> "NONE" AND VAL(NETIME$) > 0 THEN _               ' CPC15-1B
  115.        LIMIT.MINUTES.PER.SESSION! = VAL(NETIME$)                     ' CPC15-1B
  116.     IF NET.MAIL$ <> "NONE" AND VAL(NETBAUD$) > 0 THEN _              ' CPC15-1B
  117.        EXPECT.ACTIVE.MODEM = TRUE : _                                ' CPC15-1B
  118.        MODEM.INIT.BAUD$ = NETBAUD$                                   ' CPC15-1B
  119.     ARC.WORK$ = LEFT$(CALLERS.FILE$,2) + _
  120.                 "ARCWORK" + _
  121.                 MID$("1234567890ABCDEFGHIJKLMNOPQRSTUVWXYZ", _
  122.                     VAL(NODE.ID$),1) + _
  123.                 ".DEF"
  124. '
  125. ' *****************************************************************************
  126. ' *  ESTABLISH NEXT CALLERS FILE RECORD AVAILABLE                             *
  127. ' *****************************************************************************
  128. '
  129. 108 CALLERS.FILE.INDEX = 1
  130.     CALL FINDIT (CALLERS.FILE$)
  131.     CLOSE 2
  132.     CLOSE 4
  133.     OPEN "R",4,CALLERS.FILE$,64
  134.     FIELD 4,64 AS CALLERS.RECORD$
  135.     IF OK AND LOF(4) > 0 THEN _
  136.        CALLERS.FILE.INDEX = LOF(4) / 64
  137.     IF CALLERS.FILE.INDEX < 1 THEN _
  138.        CALLERS.FILE.INDEX = 0
  139.     X$ = STRING$(13,0)
  140. 110 GET 4,CALLERS.FILE.INDEX
  141.     IF LEFT$(CALLERS.RECORD$,13) = X$ THEN _
  142.        CALLERS.FILE.INDEX = CALLERS.FILE.INDEX-1 : _
  143.        GOTO 110
  144. '
  145. ' *****************************************************************************
  146. ' *  TEST FOR COLOR GRAPHICS MONITOR AND ANSI.SYS SUPPORT TO ALLOW THE LOCAL  *
  147. ' *  SYSOP TO SEE THE SAME COLOR MENUS AND SCREENS THAT THE REMOTE USER SEES  *
  148. ' *****************************************************************************
  149. '
  150. 112 IF USE.COLOR THEN _
  151.        COLOR.SUPPORT = TRUE : _
  152.        LOCAL.USER = TRUE : _
  153.        A$ = COLOR.RESET$ : _
  154.        CALL TPUT
  155.     LOCAL.USER = FALSE
  156.     UPLOAD.DRIVE.FILE$ = RIGHT$(DOWNLOAD.DRIVES$,1)+":FREESPAC.UPL"
  157. '
  158. ' *****************************************************************************
  159. ' *  TEST FOR MESSAGE FILE PRESENT (ABORT IF NOT PRESENT)                     *
  160. ' *****************************************************************************
  161. '
  162. 135 ACTIVE.MESSAGE.FILE$ = MAIN.MESSAGE.FILE$
  163.     ACTIVE.USER.FILE$ = MAIN.USER.FILE$
  164.     GOSUB 4910
  165.     GET 1,NODE.RECORD.INDEX
  166. '
  167. ' *****************************************************************************
  168. ' *  TEST FOR TIMED EXIT ACTIVE                                               *
  169. ' *****************************************************************************
  170. '
  171. 140 IF TIME.TO.DROP.TO.DOS > 0 THEN _
  172.        GOSUB 63000
  173. '
  174. ' *****************************************************************************
  175. ' *  GET CURRENT STATUS OF SYSOP AVAIL, SYSOP ANNOY, SYSOP NEXT, & PRINTER    *
  176. ' *****************************************************************************
  177. '
  178. 150 SYSOP.AVAILABLE = VAL(MID$(MESSAGE.RECORD$,32,2))
  179.     SYSOP.ANNOY = VAL(MID$(MESSAGE.RECORD$,34,2))
  180.     SYSOP.NEXT = VAL(MID$(MESSAGE.RECORD$,36,2))
  181.     PRINTER = VAL(MID$(MESSAGE.RECORD$,38,2))
  182.     IF TURN.PRINTER.OFF THEN _
  183.        PRINTER = FALSE
  184.     EXIT.TO.DOORS = VAL(MID$(MESSAGE.RECORD$,40,2))
  185.     SNOOP = VAL(MID$(MESSAGE.RECORD$,58,2))
  186.     MID$(MESSAGE.RECORD$,57,1)="I"
  187.     PUT 1,NODE.RECORD.INDEX
  188.     GOSUB 12985
  189. '
  190. ' *****************************************************************************
  191. ' *  TEST FOR MULTI LINK PRESENT IF NOT COMPAQ COMPUTER                       *
  192. ' *****************************************************************************
  193. '
  194. 160 CALL MLINIT (4)
  195. '
  196. ' *****************************************************************************
  197. ' *  TEST FOR SPECIAL FILE TRANSFER PROTOCOL SUPPORT                          *
  198. ' *****************************************************************************
  199. '
  200. 165 CALL PROTOCOL
  201. '
  202. ' *****************************************************************************
  203. ' *  DISPLAY RBBS-PC MAIN FUNCTION KEY DISPLAY                                *
  204. ' *****************************************************************************
  205. '
  206. 170 FOR FUNCTION.KEY.INDEX = 1 TO 10
  207.         KEY FUNCTION.KEY.INDEX,""
  208.     NEXT
  209.     CALL LOADNEW (M())
  210. '
  211. ' *****************************************************************************
  212. ' * IF RUNNING MORE THAN ONE NODE IN A DOS 3.X ENVIRONMENT (OR HIGHER) UNDER  *
  213. ' * MULTILINK, THEN SET THE "SHARE.IT" INDICATOR ON SO THAT ALL FILES CAN BE  *
  214. ' * ACCESSED BY ALL PARTITIONS IN A MULTI-TASKING ENVIRONMENT (I.E. MULTI-    *
  215. ' * LINK).                                                                    *
  216. ' *****************************************************************************
  217. '
  218. '    IF DOS.VERSION > 2 AND _
  219. '       MAXIMUM.NUMBER.OF.NODES > 1 AND _
  220. '       MULTI.LINK.PRESENT THEN _
  221. '          SHARE.IT = TRUE
  222. '
  223. ' *****************************************************************************
  224. ' *  INITIALIZE FILE MANAGEMENT SYSTEM, CHECK FOR LOCAL BBS MODE              *
  225. ' *****************************************************************************
  226. '
  227. 175 CALL OPENMSG
  228.     IF EC = 64 THEN _
  229.        EC = 0 : _
  230.        GOTO 5360
  231.     FIELD 1, 128 AS MESSAGE.RECORD$
  232.     CALL CTLINES (MAX.ENTRIES)
  233.     REDIM CATEGORY.NAME$(MAX.ENTRIES),CATEGORY.CODE$(MAX.ENTRIES),_
  234.           CATEGORY.DESC$(MAX.ENTRIES)
  235.     CALL INITFMS (CATEGORY.NAME$(),CATEGORY.CODE$(), _
  236.                   CATEGORY.DESC$(),NUM.CATEGORIES)
  237.     LOCAL.USER.MODE = (RIGHT$(COM.PORT$,1)<"1")
  238.     CALL BRKFNAME (CALLERS.FILE$,DRV$,X$,Y$,TRUE)
  239.     NODE.WORK.FILE$ = DRV$ + MID$(NODE.ID$,2) + ".BAT"
  240.     SECONDS.PER.SESSION! = MINUTES.PER.SESSION! * 60
  241.     IF NOT LOCAL.USER.MODE THEN _
  242.        GOTO 180
  243.     LOCAL.USER = TRUE
  244.     BPS = -6
  245.     EIGHT.BIT = TRUE
  246.     SNOOP = TRUE
  247.     RECYCLE.TO.DOS = TRUE
  248.     IF EXIT.TO.DOORS THEN _
  249.        CALL AMORPM : _
  250.        CALL READPROF : _
  251.        GOTO 410
  252.     GOTO 345
  253. 180 SUBROUTINE.PARAMETER = 2
  254.     CALL LINE25
  255. '
  256. ' *****************************************************************************
  257. ' * WAIT FOR THE PHONE TO RING AND ANSWER IT                                  *
  258. ' *****************************************************************************
  259.     SUBROUTINE.PARAMETER = 1
  260. 200 CALL ANSWERIT
  261.     IF EC > 1 THEN _
  262.        GOTO 13000
  263.     ON SUBROUTINE.PARAMETER GOTO 410,330,822,10595,13540,202
  264. 202 GOSUB 60010
  265.     SUBROUTINE.PARAMETER = 3
  266.     GOTO 200
  267. 330 GOSUB 21280
  268.     EXIT.TO.DOORS = FALSE                                            ' CPC15-1B
  269.     IF C.L <> 1 THEN _
  270.        LOCATE 22,28
  271.     PRINT "CONNECT";STR$(BAUD.TEST);"    "
  272. '
  273. ' *****************************************************************************
  274. ' *  DISPLAY WELCOME LINE                                                     *
  275. ' *****************************************************************************
  276. '
  277. 345 LOCATE 24,1
  278.     SUBROUTINE.PARAMETER = 1
  279.     CALL AMORPM
  280.     CALL FINDTIME (USER.LOGON.TIME!)
  281.     TIME.LOGGED.ON$ = TIME$
  282.     LINES.PRINTED = 0
  283.     EXPERT.USER.DEF = EXPERT.USER
  284.     EXPERT.USER = FALSE
  285.     CALL QTPUT("WELCOME TO " + RBBS.NAME$,1)
  286.     TEST.PARITY = TRUE
  287.     FILE.NAME$ = LEFT$(WELCOME.FILE$,2) + "PRELOG"
  288. 346 CALL FINDIT (FILE.NAME$)
  289.     IF OK THEN _
  290.        BYPASS.TIME.CHECK = TRUE : _
  291.        CALL BUFFILE (FILE.NAME$) : _
  292.        BYPASS.TIME.CHECK = FALSE
  293.     FF = FALSE
  294. '
  295. ' *****************************************************************************
  296. ' *  GET USER NAME                                                            *
  297. ' *  C - COMMAND FROM NEWUSER REGISTER OPTIONS (CHANGE NAME OR ADDRESS)       *
  298. ' *****************************************************************************
  299. '
  300. 400 CALL SKIPLINE(1)
  301.     UPPER.CASE = FALSE
  302.     EXPERT.USER = EXPERT.USER.DEF
  303.     A1$ = "What is your "
  304.     GOSUB 12500
  305.     CALL COMMINFO
  306.     IF FF THEN _
  307.        LOGON.ERROR.INDEX = 1 : _
  308.        GOTO 10620
  309.     IF RESTRICT.BAUD = -1 AND BPS = -1 THEN _
  310.        CALL QTPUT (LG$(7),2) : _                                     ' CPC15-1B
  311.        LOGON.ERROR.INDEX = 7 : _
  312.        GOTO 10620
  313. '
  314. ' *****************************************************************************
  315. ' *  CHECK IF SAME USER ON ANOTHER NODE                                       *
  316. ' *****************************************************************************
  317. '
  318. 410 NODE.INDEX = 2
  319.     XX = NODES.IN.SYSTEM + 1
  320. 412 IF NODE.INDEX > XX THEN _
  321.        GOTO 430
  322.     GET 1,NODE.INDEX
  323.     IF INSTR(MESSAGE.RECORD$,ACTIVE.USER.NAME$) THEN _
  324.        GOTO 420
  325.     NODE.INDEX = NODE.INDEX + 1
  326.     GOTO 412
  327. 420 IF MID$(MESSAGE.RECORD$,57,1) = "A" THEN _
  328.        LOGON.ERROR.INDEX = 6 : _
  329.        LG$(6) = LG$(6) + LEFT$(MESSAGE.RECORD$,25) : _
  330.        GOTO 10620
  331.     FIRST.NAME$ = LEFT$(MESSAGE.RECORD$,INSTR(MESSAGE.RECORD$, " ")-1)
  332.     IF NOT PRIVATE.DOOR THEN _
  333.        CALL QTPUT(FIRST.NAME$ + ", welcome back!",1)
  334.     GOTO 430
  335. '
  336. ' *****************************************************************************
  337. ' *  TEST FOR REMOTE SYSOP LOGGING ON                                         *
  338. ' *****************************************************************************
  339. '
  340. 430 GET 1,NODE.RECORD.INDEX
  341.     SAME.USER = (ACTIVE.USER.NAME$ = LEFT$(MESSAGE.RECORD$,LEN(ACTIVE.USER.NAME$)))
  342.     IF FIRST.NAME$ = SYSOP.PASSWORD.1$ AND _
  343.        LAST.NAME$ = SYSOP.PASSWORD.2$ THEN _
  344.        UPPER.CASE = FALSE : _
  345.        CI$ = "REMOTE" : _
  346.        GOTO 829
  347. '
  348. ' *****************************************************************************
  349. ' *  TEST FOR SYSOP NAME ATTEMPT                                              *
  350. ' *****************************************************************************
  351. '
  352. 445 IF INSTR(ACTIVE.USER.NAME$,"SYSOP") OR _
  353.        INSTR(ACTIVE.USER.NAME$,SYSOP.FIRST.NAME$ + " " + SYSOP.LAST.NAME$) THEN _
  354.        LOGON.ERROR.INDEX = 2 : _
  355.        GOTO 10620
  356. '
  357. ' *****************************************************************************
  358. ' *  REMOVE INVALID CHARACTERS FROM USER NAME                                 *
  359. ' *****************************************************************************
  360. '
  361. 455 CALL BADCHAR (ACTIVE.USER.NAME$)
  362.     IF ACTIVE.USER.NAME$ = "" THEN _
  363.        GOTO 400
  364. '
  365. ' *****************************************************************************
  366. ' *  CHECK FOR ACTIVE USER                                                    *
  367. ' *****************************************************************************
  368. '
  369. 457 GOSUB 12840
  370.     GOSUB 12850
  371.     GOSUB 12598
  372.     GOSUB 11482
  373.     CALL COMPDATE (TODAY.REG.YY,TODAY.REG.MM,TODAY.REG.DD,TODAY.COMPUTE.DATE!)
  374.     IF NOT FOUND THEN _
  375.        GOTO 700
  376.     GOSUB 12984
  377. '
  378. ' *****************************************************************************
  379. ' *  ACTIVE USER FOUND                                                        *
  380. ' *****************************************************************************
  381. '
  382. 459 GOSUB 9500
  383.     LAST.DATE.TIME.ON.SAVE$ = LAST.DATE.TIME.ON$
  384.     IF EXIT.TO.DOORS THEN _
  385.        USER.LOGON.TIME! = (VAL(MID$(LAST.DATE.TIME.ON$,10,2))*3600) + _
  386.                           (VAL(MID$(LAST.DATE.TIME.ON$,13,2))*60) : _
  387.        CALL TIMEREMAIN (TIME.REMAINING!)
  388.     USER.FILE.INDEX = LOC(5)
  389.     GOSUB 5135
  390.     GOSUB 5170
  391.     IF REG.DAYS.REMAINING < 0 THEN _
  392.        CALL QTPUT (LG$(9)+" - security reset to "+STR$(EXPIRED.SECURITY),1):_
  393.        LOGON.ERROR.INDEX = 9 : _
  394.        USER.SECURITY.LEVEL = EXPIRED.SECURITY : _
  395.        LSET SECURITY.LEVEL$ = MKI$(USER.SECURITY.LEVEL) : _          ' CPC15-1B
  396.        GOSUB 5135
  397. 460 USER.SECURITY.LEVEL$ = STR$(USER.SECURITY.LEVEL)                 ' CPC15-1B
  398.     IF USER.SECURITY.LEVEL > -1 THEN _
  399.        USER.SECURITY.LEVEL$ = MID$(USER.SECURITY.LEVEL$,2)
  400.     FILE.NAME$ = "LG" + USER.SECURITY.LEVEL$ + ".DEF"
  401.     BYPASS.TIME.CHECK = TRUE
  402.     CALL OPENWORK (FILE.NAME$)
  403.     IF EC = 0 THEN _
  404.        GOSUB 6000
  405.     BYPASS.TIME.CHECK = FALSE
  406.     IF USER.SECURITY.LEVEL >= MINIMUM.LOGON.SECURITY THEN _
  407.        GOTO 470
  408.     IF LOGON.ERROR.INDEX < 9 AND _                                   ' CPC15-1B
  409.        EC = 0 THEN _                                                 ' CPC15-1B
  410.        LOGON.ERROR.INDEX = 8
  411.     GOTO 10620
  412. 470 GOSUB 12989
  413.     CI$ = CITY.STATE$
  414.     ATTEMPTS.ALLOWED = 4
  415.     PASSWORD.SAVE$ = PASSWORD$
  416.     TEMP.SYSOP = (USER.SECURITY.LEVEL >= SYSOP.SECURITY.LEVEL)
  417.     MESSAGE.PASSWORD = FALSE
  418.     IF CURRENT.DATE$ <> LEFT$(LAST.DATE.TIME.ON$,8) THEN _
  419.        ELAPSED.TIME = 0 _
  420.     ELSE ELAPSED.TIME = CVI(ELAPSED.TIME$)
  421.     IF PASSWORD.SAVE$ = SPACE$(LEN(PASSWORD.SAVE$)) THEN _
  422.        GOSUB 755 : _
  423.        GOTO 800
  424. 480 IF PRIVATE.DOOR THEN _
  425.        Z$ = PASSWORD.SAVE$ : _
  426.        PASSWORD.FAILED = 0 : _
  427.        GOTO 644
  428.     IF Q = 3 THEN _
  429.        Z$ = B$(3) : _
  430.        ATTEMPTS = 1 : _
  431.        GOSUB 677 _
  432.     ELSE GOSUB 675
  433. 630 IF PASSWORD.FAILED THEN _
  434.        LOGON.ERROR.INDEX = 4 : _
  435.        GOTO 10620
  436. 643 GOSUB 41070
  437. 644 NEW.USER = FALSE
  438.     WK$ = RIGHT$(STR$(ASC(MID$(LIST.NEW.DATE$,2))),2) + _   ' MM
  439.            "/" + _
  440.            RIGHT$(STR$(ASC(MID$(LIST.NEW.DATE$,3))),2) + _   ' DD
  441.            "/" + _
  442.            RIGHT$(STR$(ASC(LIST.NEW.DATE$)),2)               ' YY
  443.     LM$ = RIGHT$(WK$,2) + _                                 ' YY
  444.           LEFT$(WK$,2) + _                                  ' MM
  445.           MID$(WK$,4,2)                                     ' DD
  446.     IF MID$(LM$,3,1) = " " THEN _
  447.        MID$(LM$,3,1) = "0"
  448. 655 IF MID$(LM$,5,1) = " " THEN _
  449.        MID$(LM$,5,1) = "0"
  450. 660 CALL MUSIC (1)
  451.     GOTO 800
  452. '
  453. ' *****************************************************************************
  454. ' *  USER & MESSAGE PASSWORD VALIDATION                                       *
  455. ' *****************************************************************************
  456. '
  457. 665 SUBROUTINE.PARAMETER = 1
  458.     GOTO 678
  459. 667 SUBROUTINE.PARAMETER = 2
  460.     GOTO 678
  461. 670 SUBROUTINE.PARAMETER = 3
  462.     GOTO 678
  463. 675 SUBROUTINE.PARAMETER = 4
  464.     GOTO 678
  465. 677 SUBROUTINE.PARAMETER = 5
  466. 678 CALL PASSWORD
  467.     RETURN
  468. '
  469. ' *****************************************************************************
  470. ' *  ACTIVE USER NOT FOUND (NEWUSER ROUTINE)                                  *
  471. ' *****************************************************************************
  472. '
  473. 700 EXPERT.USER = FALSE
  474.     IF RESTRICT.BAUD = -2 AND BPS = -1 THEN _
  475.        LOGON.ERROR.INDEX = 7 : _
  476.        A$ = "(300 BAUD ACCESS FOR REGISTERED USERS ONLY)  " : _
  477.        GOSUB 12976 : _
  478.        GOTO 10620
  479.     Z$ = FIRST.NAME$
  480.     GOSUB 12570
  481.     IF FOUND THEN _
  482.        GOSUB 12984 : _
  483.        GOTO 12595
  484.     Z$ = LAST.NAME$
  485.     GOSUB 12570
  486.     IF FOUND THEN _
  487.        GOSUB 12984 : _
  488.        GOTO 12595
  489. 710 IF USER.FILE.INDEX = 0 AND NOT SURVIVE.NOUSER.ROOM THEN _
  490.        GOTO 13540
  491. 720 USER.SECURITY.LEVEL = DEFAULT.SECURITY.LEVEL
  492. 725 IF USER.SECURITY.LEVEL < MINIMUM.LOGON.SECURITY THEN _           ' CPC15-1B
  493.        LOGON.ERROR.INDEX = 1 : _                                     ' CPC15-1B
  494.        GOTO 460                                                      ' CPC15-1B
  495.     IF FIRST.NAME$ = LAST.NAME$ THEN _                               ' CPC15-1B
  496.        LOGON.ERROR.INDEX = 3 : _
  497.        GOTO 10620
  498.     IF NOT REMEMBER.NEW.USERS THEN _
  499.        GOSUB 13700 : _
  500.        USER.FILE.INDEX = 0 : _
  501.        GOSUB 12960: _
  502.        PREV.LAST.ON$ = "00/00/00": _
  503.        GOTO 735
  504.     NEW.USER = TRUE
  505.     CALL OPENUSER
  506.     GOSUB 9450
  507.     GOSUB 12630
  508.     MID$(USER.RECORD$,START.HASH,LEN.HASH) = LEFT$("NEWUSER",LEN.HASH)
  509.     IF START.INDIV>0 THEN _
  510.        MID$(USER.RECORD$,START.INDIV,LEN.INDIV) = INDIV.VALUE$
  511.     PUT 5,USER.FILE.INDEX
  512. 730 GOSUB 12960
  513. 735 BYPASS.TIME.CHECK = TRUE
  514.     LINES.PRINTED = 0
  515.     FILE.NAME$ = NEWUSER.FILE$
  516.     STOP.INTERRUPTS = FALSE
  517.     GOSUB 1790
  518.     STOP.INTERRUPTS = TRUE
  519.     BYPASS.TIME.CHECK = FALSE
  520. 739 CALL QTPUT(ACTIVE.USER.NAME$ + " from " + CI$,1)
  521. 740 A$ = "<C>hange name/address, <D>isconnect, <R>egister"
  522.     GOSUB 12995
  523.     CALL ALLCAPSD (B$(),1)
  524.     Z$ = B$(1)
  525.     S = INSTR("CDR",Z$)
  526. 745 IF NOT REMEMBER.NEW.USERS THEN _
  527.        ON S GOTO 748,752,754
  528.     ON S GOTO 747,750,760
  529.     GOTO 740
  530. 747 CALL UPDTCALR (ACTIVE.USER.NAME$ + " from " + CI$ +_
  531.                            " changed Name/Address",2)
  532.     MID$(USER.RECORD$,START.HASH,LEN.HASH) = STRING$(LEN.HASH,0)
  533.     PUT 5,USER.FILE.INDEX
  534.     GOSUB 12991
  535. 748 FF = FALSE
  536.     GOTO 400
  537. '
  538. ' *****************************************************************************
  539. ' *  D - COMMAND FROM NEWUSER ROUTINE (DISCONNECT - REFUSE TO REGISTER)       *
  540. ' *****************************************************************************
  541. '
  542. 750 CALL UPDTCALR (ACTIVE.USER.NAME$ + " from " + CI$ + _
  543.                            " didn't register",2)
  544.     MID$(USER.RECORD$,START.HASH,LEN.HASH) = STRING$(LEN.HASH,0)
  545.     PUT 5,USER.FILE.INDEX
  546.     GOSUB 12991
  547. 752 FF = FALSE
  548.     USER.FILE.INDEX = 0
  549.     GOTO 13540
  550. '
  551. ' *****************************************************************************
  552. ' *  GET AND VERIFY PASSWORD                                                  *
  553. ' *****************************************************************************
  554. '
  555. 754 CALL QTPUT ("GUEST privileges granted.  RE-REGISTER on future calls",1)
  556.     GOTO 832
  557. 755 IF PRIVATE.DOOR THEN _
  558.        B$(1) = PASSWORD$ : _
  559.        Z$ = B$(1) : _
  560.        GOSUB 1275 : _
  561.        RETURN
  562.     GOSUB 12800
  563.     A$ = "Re-enter PASSWORD for verification (Dots Echo)"
  564.     GOSUB 45010
  565.     SWAP Z$,B$(1)
  566.     CALL ALLCAPS (Z$)
  567.     IF B$(1) <> Z$ THEN _
  568.        CALL QTPUT ("Passwords Don't match!",1) : _
  569.        GOTO 755
  570.     RETURN
  571. '
  572. ' *****************************************************************************
  573. ' *  R - COMMAND FROM NEWUSER ROUTINE - REGISTER                              *
  574. ' *****************************************************************************
  575. '
  576. 760 GOSUB 755
  577.     CALL ALLCAPS (Z$)
  578.     LSET PASSWORD$ = Z$
  579.     CALL QTPUT("Please REMEMBER your password",1)
  580.     TEMP.SECURITY.LEVEL = USER.SECURITY.LEVEL
  581.     IF NEWUSER.SETS.DEFAULTS THEN _
  582.        GOSUB 42950 : _
  583.        BYPASS.TIME.CHECK = TRUE : _
  584.        GOSUB 43000 : _
  585.        BYPASS.TIME.CHECK = FALSE : _
  586.        GOSUB 43030 : _
  587.        GOSUB 42800 : _
  588.        GOSUB 42700 _
  589.     ELSE UPPER.CASE = FALSE : _
  590.          GR = 0 : _
  591.          USER.GRAPHIC.DEFAULT$ = " " : _
  592.          NULLS = FALSE : _
  593.          USER.TRANSFER.DEFAULT$ = " "
  594.     GOSUB 12900
  595.     CALL DEFAULTU
  596.     QUESTIONNAIRE$ = "RBBS-REG.DEF"
  597.     GOSUB 11510
  598.     LSET SECURITY.LEVEL$ = MKI$(USER.SECURITY.LEVEL)
  599. '
  600. ' *****************************************************************************
  601. ' *  LOGIN ALL USERS                                                          *
  602. ' *****************************************************************************
  603. '
  604. 800 MAIN.USER.FILE.INDEX = USER.FILE.INDEX
  605.     USER.SECURITY.SAVE = USER.SECURITY.LEVEL
  606.     TIMES.LOGGED.ON = CVI(MID$(USER.OPTIONS$,1,2)) + 1
  607.     LINES.PRINTED = 0
  608.     GOSUB 9500
  609.     PREV.LAST.ON$ = LAST.DATE.TIME.ON$
  610.     IF PRIVATE.DOOR THEN _
  611.        GOTO 815
  612.     IF (EIGHT.BIT AND _
  613.        AUTODOWNLOAD.DESIRED) OR _                                    ' CPC15-1B
  614.        ASK.IDENTITY THEN _
  615.        CALL TESTUSER
  616.     CALL QTPUT ("Logging " + ACTIVE.USER.NAME$,1)
  617.     CALL QTPUT ("RBBS-PC " + VERSION.ID$ + " NODE " + NODE.ID$,1)
  618.     CALL QTPUT (" OPERATING AT " + BAUD.PARITY$,1)
  619.     ATTEMPTS = 0
  620. 805 IF EIGHT.BIT AND AUTODOWNLOAD.AVAILABLE THEN _                   ' CPC15-1B
  621.        A$ = CHR$(7) + CHR$(9) + RETURN.LINE.FEED$ + _
  622.             CHR$(7) + "You may use " + _
  623.             CHR$(7) + "AUTODOWNLOADing!" + _
  624.             CHR$(7) + RETURN.LINE.FEED$ + CHR$(7) : _
  625.        GOSUB 12979 : _
  626.        CALL DELAYIT(4)
  627. 815 DOWNLOADS = CVI(USER.DOWNLOADS$)
  628.     UPLOADS = CVI(USER.UPLOADS$)
  629.     LAST.MESSAGE.READ = -LAST.MESSAGE.READ*(LAST.MESSAGE.READ <= HIGH.MESSAGE.NUMBER)
  630.     LSET USER.OPTIONS$ = MKI$(TIMES.LOGGED.ON) + _
  631.                          MID$(USER.OPTIONS$,3)
  632.     LSET LAST.DATE.TIME.ON$ = CURRENT.DATE$ + " " + TIME.LOGGED.ON$
  633.     MID$(USER.RECORD$,START.HASH,LEN.HASH) = HASH.VALUE$
  634.     IF START.INDIV>0 THEN _
  635.        MID$(USER.RECORD$,START.INDIV,LEN.INDIV) = INDIV.VALUE$
  636.     LSET USER.NAME$ = ACTIVE.USER.NAME$
  637.     PUT 5,USER.FILE.INDEX
  638.     GOSUB 12991
  639.     IF PRIVATE.DOOR THEN _
  640.        GOTO 821
  641.     IF NOT SAME.USER THEN _
  642.        STOP.INTERRUPTS = WELCOME.INTERRUPTABLE : _
  643.        BYPASS.TIME.CHECK = TRUE : _
  644.        FILE.NAME$ = WELCOME.FILE$ : _
  645.        GOSUB 1790
  646.        BYPASS.TIME.CHECK = FALSE : _
  647.        STOP.INTERRUPTS = FALSE
  648. 816 IF NOT NEW.USER THEN _
  649.        CALL QTPUT("Times on:" + STR$(TIMES.LOGGED.ON) + _
  650.             "  Last time on was: " + PREV.LAST.ON$,1)
  651. 817 IF REMIND.FILE.TRANSFERS THEN _
  652.        A$ = "Files Downloaded:" + _
  653.             STR$(DOWNLOADS) + _
  654.             "  Uploaded:" + _
  655.             STR$(UPLOADS) : _
  656.        GOSUB 12977
  657. 820 LINES.PRINTED = 0
  658.     IF REMIND.PROFILE THEN _
  659.        GOSUB 5400
  660.     LINES.PRINTED = 0
  661. 821 CI$ = LEFT$(CI$ + SPACE$(2),INSTR(CI$ +SPACE$(2),SPACE$(2))-1)
  662.     GOTO 832
  663. '
  664. ' *****************************************************************************
  665. ' *  ESC PRESSED ON LOCAL CONSOLE ENTERS HERE                                 *
  666. ' *****************************************************************************
  667. '
  668. 822 LOCATE 24,1
  669.     CALL FINDTIME (USER.LOGON.TIME!)
  670.     GOSUB 14500
  671.     LOCAL.USER = TRUE
  672.     WAIT.BEFORE.DISCONNECT = 32400
  673.     BPS = -6
  674.     CALL MUSIC (2)
  675.     IF LOCAL.PASSWORD$ = "NONE" THEN _
  676.        GOTO 828
  677.     A$ = "Enter PASSWORD (dots echo) "
  678.     PRINT A$;
  679.     Z$ = ""
  680.     INKEYS.PRESSED = 0
  681. 823 A$ = INKEY$
  682.     IF A$ = "" THEN _
  683.        GOTO 823
  684.     IF A$ = CARRIAGE.RETURN$ THEN _
  685.        GOTO 824
  686.     IF (A$ = CHR$(8)) AND (INKEYS.PRESSED > 0) THEN _
  687.        PRINT BACK.ARROW$; : _
  688.        INKEYS.PRESSED = INKEYS.PRESSED - 1 : _
  689.        IF LEN(Z$) > 1 THEN _
  690.           Z$ = LEFT$(Z$,LEN(Z$)-1) : _
  691.           GOTO 823 _
  692.        ELSE Z$ = "" : _
  693.           GOTO 823
  694.     IF ASC(A$) > 127 OR _
  695.        ASC(A$) < 32 THEN _
  696.        GOTO 823
  697.     Z$= Z$ + A$
  698.     PRINT ".";
  699.     INKEYS.PRESSED = INKEYS.PRESSED + 1
  700.     GOTO 823
  701. 824 PRINT A$;
  702.     CALL ALLCAPS (Z$)
  703.     IF Z$ <> LOCAL.PASSWORD$ THEN _
  704.        GOTO 13549
  705. 828 EIGHT.BIT = TRUE
  706.     GR = 1
  707.     CI$ = "LOCAL"
  708.     LINE.FEEDS = TRUE
  709.     RETURN.LINE.FEED$ = LINE.FEED$
  710.     USER.SECURITY.LEVEL = SYSOP.SECURITY.LEVEL
  711. 829 FIRST.NAME$ = SYSOP.FIRST.NAME$
  712.     LAST.NAME$ = SYSOP.LAST.NAME$
  713.     ACTIVE.USER.NAME$ = "SYSOP"
  714.     USER.SECURITY.LEVEL = SYSOP.SECURITY.LEVEL
  715.     GOSUB 5135
  716.     SYSOP = TRUE
  717.     REQ.QUES.ANSWERED = TRUE
  718.     REG.DAYS.REMAINING = 365
  719.     GOSUB 11482
  720.     CALL COMPDATE (TODAY.REG.YY,TODAY.REG.MM,TODAY.REG.DD,TODAY.COMPUTE.DATE!)
  721.     X$ = DATE$
  722.     PREV.LAST.ON$ = LEFT$(X$,6) + RIGHT$(X$,2)
  723.     SUBROUTINE.PARAMETER = 1
  724.     CALL AMORPM
  725.     IF LOCAL.USER THEN _
  726.        SNOOP = TRUE : _
  727.        SYSOP.NEXT = TRUE : _
  728.        GOSUB 33090
  729.     LINES.PRINTED = 0
  730. 832 IF REG.DAYS.REMAINING <= DAYS.TO.WARN AND _
  731.        RESTRICT.BY.DATE AND REG.DAYS.REMAINING > 0 THEN _
  732.        CALL QTPUT ("Subscription EXPIRES in"+STR$(REG.DAYS.REMAINING)+" days!",1) : _
  733.        CALL DELAYIT (5)
  734.     IF (NOT REQ.QUES.ANSWERED) AND _
  735.        REQUIRED.QUESTIONNAIRE$ <> "" THEN _
  736.        QUESTIONNAIRE$ = REQUIRED.QUESTIONNAIRE$: _
  737.        GOSUB 11510: _
  738.        IF OK THEN _
  739.           REQ.QUES.ANSWERED = TRUE
  740. 836 IF LOCAL.USER THEN _
  741.        SNOOP = TRUE : _
  742.        LINE.FEEDS = TRUE : _
  743.        CI$ = "LOCAL" : _
  744.        A = INSTR(TRANSFER.OPTIONS$,CARRIAGE.RETURN$) : _
  745.        IF A>0 THEN _
  746.           MID$(TRANSFER.OPTIONS$,A,1) = " "
  747. 837 Z$ = ACTIVE.USER.NAME$ + _
  748.             " on at " + _
  749.             CURRENT.DATE$ + _
  750.             ", " + _
  751.             TIM$ + _
  752.             " from " + _
  753.             CI$ + _
  754.             ", " + _
  755.             BAUD.PARITY$
  756.      NG$ = Z$ + SPACE$(128-LEN(Z$))
  757.      GOSUB 12860
  758.      CALL PRINTIT ("  " + Z$)
  759.      IF NEW.USER THEN _
  760.         CALL UPDTCALR ("NEWUSER",1) : _
  761.         CALL MUSIC (2) : _
  762.         NEW.USER = FALSE
  763. 842 SECONDS.PER.SESSION! = (MINUTES.PER.SESSION! + LIMIT.DAILY.TIME * ELAPSED.TIME) * 60
  764.     GOSUB 4910
  765.     CALLS.TODATE! = CALLS.TODATE! + 1 + SYSOP
  766.     GOSUB 24000
  767.     GET 1,NODE.RECORD.INDEX
  768.     MID$(MESSAGE.RECORD$,1,31) = ACTIVE.USER.NAME$ + SPACE$(31-LEN(ACTIVE.USER.NAME$))
  769.     MID$(MESSAGE.RECORD$,40,2) = " 0"
  770.     MID$(MESSAGE.RECORD$,55,2) = " 0"
  771.     MID$(MESSAGE.RECORD$,57,1) = "A"
  772.     MID$(MESSAGE.RECORD$,60,4) = BAUD.PARITY$
  773.     MID$(MESSAGE.RECORD$,72,2) = STR$(FALSE)
  774.     MID$(MESSAGE.RECORD$,93,24) = CI$ + SPACE$(24)                   ' CPC15-1B
  775.     PUT 1,NODE.RECORD.INDEX
  776.     GOSUB 12985
  777.     SYSOP = (USER.SECURITY.LEVEL >= SYSOP.SECURITY.LEVEL)
  778.     SUBROUTINE.PARAMETER = 2
  779. 850 CALL LINE25
  780.     CALL SKIPLINE (1)
  781.     IF PRIVATE.DOOR OR EXIT.TO.DOORS THEN _
  782.        GOTO 900
  783.     IF M(1,1) < 1 THEN _
  784.        LAST.NEW = 0 _
  785.     ELSE CALL CTNEWFILES (PREV.LAST.ON$,M(),LAST.NEW)
  786.     IF LAST.NEW > 22 THEN _
  787.        A$ = "At least"_
  788.     ELSE A$ = ""
  789.     IF FMS.DIRECTORY$ <> "" THEN _
  790.        CALL QTPUT(A$ + STR$(LAST.NEW) + " NEW file(s) since last on",1) _
  791.     ELSE GOTO 852
  792.     IF NOT NEW.FILES.CHECK OR LAST.NEW < 1 THEN _
  793.        GOTO 852
  794.     L = LEN(DOWNLOAD.DRIVES$)
  795.     IF (NOT SKIP.FILES.LOGON) AND _
  796.        (USER.SECURITY.LEVEL >= MIN.SEC.TO.VIEW) AND _
  797.        USER.SECURITY.LEVEL >= OPT.SEC(18) THEN _
  798.           A$ = "Review new files to download ([Y],N)" :_
  799.           GOSUB 12995 :_
  800.           IF NOT NO THEN _
  801.              Q = 3:_
  802.              B$(2) = MID$(PREV.LAST.ON$,1,2) + MID$(PREV.LAST.ON$,4,2) +_
  803.                      MID$(PREV.LAST.ON$,7,2):_
  804.              Y$ = B$(3) : _
  805.              CALL BRKFNAME (FMS.DIRECTORY$,DR$,Y$,X$,FALSE): _
  806.              B$(3) = Y$ : _
  807.              GOSUB 53000
  808. 852 IF USER.SECURITY.LEVEL < OPT.SEC (2) OR _                        ' CPC15-1B
  809.        ACTIVE.BULLETINS < 1 OR _                                     ' CPC15-1B
  810.        SYSOP OR _                                                    ' CPC15-1B
  811.        SAME.USER THEN _                                              ' CPC15-1B
  812.        GOTO 900
  813. 855 IF NOT BULLETINS.OPTIONAL THEN _
  814.        GOTO 860
  815.     IF NOT CHECK.BULLETIN.LOGON THEN _
  816.        ANS.INDEX = 0 : _
  817.        GOSUB 9760 : _
  818.        GOTO 900
  819.     CALL SKIPLINE (1)
  820.     A$ = "Skip the" + STR$(ACTIVE.BULLETINS) + " bulletins"
  821.     GOSUB 12995
  822.     IF YES THEN _
  823.        GOTO 900
  824. 860 GOSUB 9705
  825. 900 GOSUB 1900
  826.     SUBROUTINE.PARAMETER = 2
  827.     CALL LINE25
  828.     CALL CALLOPT
  829.     SECTION$ = "    "
  830.     IF PRIVATE.DOOR THEN _
  831.        GOSUB 20266 : _
  832.        GOSUB 1275 : _
  833.        GOTO 1205
  834. 955 GOSUB 4850
  835. '
  836. ' *****************************************************************************
  837. ' *                                                                           *
  838. ' *                           COMMAND PROCESSING                              *
  839. ' *                                                                           *
  840. ' *****************************************************************************
  841. '
  842. 1200 CLOSE 1
  843.      GOSUB 1280
  844. 1205 CHAT.AVAILABLE = TRUE
  845.      SUBROUTINE.PARAMETER = 1
  846.      STOP.INTERRUPTS = TRUE
  847.      NON.STOP = FALSE
  848.      Q = 0
  849.      GOSUB 12979
  850. 1210 GOSUB 41000
  851.      CALL DISPLAYTR (TIME.REMAINING!)
  852.      IF EXPERT.USER THEN _
  853.         GOTO 1230
  854.      LINES.PRINTED = 0
  855.      IF SUB.SECTION < BEG.FILE THEN _
  856.         IF SYSOP THEN _
  857.            FILE.NAME$ = MENU$(1) : _
  858.            GOSUB 43025
  859.      FILE.NAME$ = MENU$(MENU.INDEX)
  860.      GOSUB 43025
  861. 1230 CALL LINE25
  862.      CALL SKIPLINE (1)
  863.      IF CONFERENCE.MODE THEN _
  864.         A$ = GRN$ : _
  865.         GOSUB 12979
  866.      A$ = COMMAND.PROMPT$
  867.      GOSUB 12995
  868.      IF Q = 0 THEN _
  869.         GOTO 1230
  870. 1235 Z$ = B$(1)
  871.      IF LEN(Z$) < 1 THEN _
  872.         GOTO 1230
  873.      CALL ALLCAPS (Z$)
  874.      CALL SRCHCMND (SUB.SECTION,FF)
  875.      IF FF < 1 THEN _
  876.         GOSUB 1305 : _
  877.         GOTO 1230
  878.      IF ASC(Z$) = 32 THEN _
  879.         GOTO 1230
  880.      IF USER.SECURITY.LEVEL < OPT.SEC(FF) THEN _
  881.         VIOLATION$ = SECTION$+" "+Z$ : _
  882.         GOSUB 1380 : _
  883.         GOTO 1205
  884.         ON FF GOSUB _
  885.                  1400, _               ' A)nswer questionnaire 1
  886.                  9700, _               ' B)ulletins
  887.                  1800, _               ' C)omments
  888.                  10970, _              ' D)oor (exit to)
  889.                  2000, _               ' E)nter a message
  890.                  1275, _               ' F)ile system (exit to)
  891.                  1760, _               ' I)nitial welcome redisplayed
  892.                  5300, _               ' J)oin a conference
  893.                  3900, _               ' K)ill a message
  894.                  4700, _               ' O)perator page
  895.                  1900, _               ' P)ersonal mail (look for)
  896.                  4330, _               ' R)ead messages
  897.                  4340, _               ' S)can message headers
  898.                  4320, _               ' T)opic msg scan
  899.                  1285, _               ' U)tilities (exit to)
  900.                  5800, _               ' V)iew a conference
  901.                  9800, _               ' W)ho's on other nodes displayed 17
  902.                 20180, _               ' D)ownload 1
  903.                 10570, _               ' G)oodbye
  904.                 20150, _               ' L)ist
  905.                 53000, _               ' N)ew
  906.                 52900, _               ' S)can
  907.                 20400, _               ' U)pload 6
  908.                 20140, _               ' V)iew ARC Contents
  909.                  5500, _               ' B)aud rate change 300==>450 1
  910.                  9100, _               ' C)lock (time & time on)
  911.                  42800, _              ' F)ile transfer protocol
  912.                  43000, _              ' G)raphics
  913.                  5200, _               ' L)ines per page
  914.                  10925, _              ' M)essage margin
  915.                  5110, _               ' P)assword change
  916.                  5400, _               ' R)eview preferences
  917.                  4850, _               ' S)tatistics displayed
  918.                  1500, _               ' T)oggle
  919.                  10090, _              ' U)serlog displayed 11
  920.                  1325, _               ' H)elp 1
  921.                  1325, _               ' ?)help
  922.                  1250, _               ' Q)uit
  923.                  4240, _               ' X)expert toggle on/off 4
  924.                  10070, _              ' 1) List comments file 1
  925.                  10090, _              ' 2) List callers file
  926.                  10390, _              ' 3) Recover a message
  927.                  10530, _              ' 4) Erase comments
  928.                  11000, _              ' 5) User file maintenance
  929.                  33070, _              ' 6) Toggle page bell on/off
  930.                  10930                 ' 7) Exit to DOS 2.x or above 7
  931.      GOTO 1205
  932. ' ************************************************************
  933. ' *              QUIT COMMAND (GLOBAL)                       *
  934. ' ************************************************************
  935. 1250 IF Q>1 THEN _
  936.         ANS.INDEX = 2: _
  937.         GOTO 1270
  938. 1260 ANS.INDEX = 1
  939.      IF EXPERT.USER THEN _
  940.         A$ = "QUIT to F,[M],U,S"_
  941.      ELSE _
  942.         A$ = "QUIT to F)ile, [M]ain, U)til section or S)ystem (hang up) ([ENTER]=M)"
  943.      GOSUB 12995
  944.      IF Q = 0 THEN _
  945.         Q = 1: _
  946.         B$(1) = "M"
  947. 1270 Z$ = B$(ANS.INDEX)
  948.      CALL ALLCAPS (Z$)
  949.      ON INSTR("FMUS",Z$) GOTO 1275,1280,1285,10570
  950.      GOTO 1260
  951. 1275 LSET SECTION$ = "FILE"
  952.      SECTION.OPTS$ = FILE.OPTS$
  953.      SUB.SECTION = BEG.FILE
  954.      MENU.INDEX = 3
  955.      GOTO 1295
  956. 1280 LSET SECTION$ = "MAIN"
  957.      SECTION.OPTS$ = MAIN.OPTS$
  958.      SUB.SECTION = BEG.MAIN
  959.      MENU.INDEX = 2
  960.      GOTO 1295
  961. 1285 LSET SECTION$ = "UTIL"
  962.      SECTION.OPTS$ = UTIL.OPTS$
  963.      SUB.SECTION = BEG.UTIL
  964.      MENU.INDEX = 4
  965.      GOTO 1295
  966. 1295 ACTIVE.MENU$ = LEFT$(SECTION$,1)
  967.      IF SHOW.SECTION THEN _
  968.         SECTION.PROMPT$ = SECTION$ _
  969.      ELSE SECTION.PROMPT$ = "Your"
  970.      IF COMMANDS.IN.PROMPT=0 THEN _
  971.          SECTION.OPTS$ = ""
  972.      COMMAND.PROMPT$ = SECTION.PROMPT$ + " command" + SECTION.OPTS$
  973.      RETURN
  974. 1300 CALL QTPUT ("Message base " + GRN$,1)
  975.      RETURN
  976. 1305 CALL QTPUT(PRESENT.OPTS$,1)
  977.      CALL QTPUT(CALLERS.OPTS$,1)
  978.      RETURN
  979. ' ****************************************************************
  980. ' *                     HELP (GLOBAL)                            *
  981. ' ****************************************************************
  982. 1325 CALL HELP (SUB.SECTION,USER.GRAPHIC.DEFAULT$,_
  983.                 MID$("MAINFILEUTIL",(MENU.INDEX-2)*4+1,4))
  984.      IF SUBROUTINE.PARAMETER = -1 THEN _
  985.         RETURN 10595
  986.      RETURN
  987. '
  988. ' *****************************************************************************
  989. ' *  RECORD SECURITY VIOLATIONS                                               *
  990. ' *****************************************************************************
  991. '
  992. 1380 A$ = "SYSOP must authorize"
  993.      GOSUB 1397
  994.      CALL UPDTCALR ("SV!-"+VIOLATION$,2)
  995.      CALL MUSIC (3)
  996.      VIOLATIONS.THIS.SESSION = VIOLATIONS.THIS.SESSION + 1
  997.      IF MAXIMUM.VIOLATIONS = 0 OR VIOLATIONS.THIS.SESSION <= MAXIMUM.VIOLATIONS THEN _
  998.         RETURN
  999. 1385 IF USER.FILE.INDEX < 1 THEN _
  1000.         RETURN
  1001.      A$ = "SECURITY VIOLATION!  Sysop can reinstate"
  1002.      IF USER.SECURITY.LEVEL <= MINIMUM.LOGON.SECURITY THEN _
  1003.         A$ = "" : _
  1004.         USER.SECURITY.LEVEL = USER.SECURITY.LEVEL-1 _
  1005.      ELSE USER.SECURITY.LEVEL = MINIMUM.LOGON.SECURITY
  1006. 1386 GOSUB 12979
  1007.      LOGON.ERROR.INDEX = 5
  1008.      GOSUB 12989
  1009.      CALL OPENUSER
  1010.      GOSUB 9450
  1011.      GET 5,USER.FILE.INDEX
  1012.      LSET SECURITY.LEVEL$ = MKI$(USER.SECURITY.LEVEL)
  1013.      PUT 5,USER.FILE.INDEX
  1014.      GOTO 10620
  1015. 1397 A$ = "Sorry, " + FIRST.NAME$ + ", " + A$
  1016.      GOTO 12976
  1017. '
  1018. ' *****************************************************************************
  1019. ' *  END KEY - FORCE CURRENT USER OFF AND LOCK THEM OUT                       *
  1020. ' *****************************************************************************
  1021. '
  1022. 1398 CALL CARRIER
  1023.      IF SUBROUTINE.PARAMETER THEN _
  1024.         RETURN
  1025.      FUNCTION.KEY = 0
  1026.      IF INSTR("MUF",ACTIVE.MENU$)>0 THEN_
  1027.         GOTO 1399
  1028.      CURSOR.LINE = CSRLIN
  1029.      CURSOR.ROW = POS(0)
  1030.      LOCATE 25,1
  1031.      PRINT SPACE$(79);
  1032.      LOCATE 25,1
  1033.      PRINT "Cannot FORCE OFF until user reaches MAIN menu";
  1034.      CALL DELAYIT (1)
  1035.      LOCATE CURSOR.LINE,CURSOR.ROW
  1036.      SUBROUTINE.PARAMETER = 1
  1037.      CALL LINE25
  1038.      RETURN
  1039. 1399 A$ = FIRST.NAME$ + ", goodbye and don't call back"
  1040.      GOSUB 12975
  1041.      IF USER.FILE.INDEX < 1 THEN _
  1042.         GOTO 10698
  1043.      USER.SECURITY.LEVEL = MINIMUM.LOGON.SECURITY - 1
  1044.      GOTO 1386
  1045. '
  1046. ' *****************************************************************************
  1047. ' *  ANSWER - COMMAND FROM MAIN MENU (ANSWER QUESTIONNAIRE)                   *
  1048. ' *****************************************************************************
  1049. '
  1050. 1400 IF Q > 1 THEN _
  1051.         ANS.INDEX = 2:_
  1052.         GOTO 1407
  1053. 1402 CALL BUFFILE (ANS.MENU$)
  1054.      IF NOT OK THEN _
  1055.         CALL QTPUT("No questionnaires available",1):_
  1056.         RETURN
  1057. 1405 A$ = "Answer which questionnaire"
  1058.      GOSUB 12998
  1059.      IF Q = 0 THEN _
  1060.         RETURN
  1061.      CALL CARRIER
  1062.      IF SUBROUTINE.PARAMETER = -1 THEN _
  1063.         RETURN 10595
  1064.      ANS.INDEX = 1
  1065. 1407 Z$ = B$(ANS.INDEX)
  1066.      CALL WORDINFILE (ANS.MENU$,Z$,FOUND)
  1067.      IF NOT FOUND THEN _
  1068.         CALL QTPUT ("No such questionnaire "+Z$,1):_
  1069.         GOTO 1402
  1070.      QUESTIONNAIRE.HOLD$ = Z$
  1071.      QUESTIONNAIRE$ = Z$+".DEF"
  1072.      GOSUB 11510
  1073. 1415 IF NOT OK THEN _
  1074.         CALL UPDTCALR ("Missing questionnaire " + Z$,2) : _
  1075.         GOTO 1402
  1076. 1424 CLOSE 2
  1077.      CALL UPDTCALR (QUESTIONNAIRE.HOLD$ + " Questionnaire answered",2)
  1078.      RETURN
  1079. '
  1080. ' *****************************************************************************
  1081. ' *             TOGGLE COMMAND (UTILITIES)                                    *
  1082. ' *****************************************************************************
  1083. '
  1084. 1500 IF Q>1 THEN _
  1085.         ANS.INDEX = 2 : _
  1086.         LAST.INDEX = Q : _
  1087.         GOTO 1510
  1088. 1502 ANS.INDEX = 1
  1089.      CALL QTPUT("TOGGLE which options on/off?"+PRESS.ENTER$,1)
  1090.      A$ = "A)utodownload,B)ulletin,C)ase,F)ile,L)ine feeds,N)ulls,X)expert,!)bell"
  1091.      GOSUB 12995
  1092.      IF Q=0 THEN _
  1093.         RETURN
  1094.      LAST.INDEX = Q
  1095. 1510 Z$ = B$(ANS.INDEX)
  1096.      CALL ALLCAPS (Z$)
  1097.      FF = INSTR("ABCFLNX!",Z$)
  1098.      IF FF<1 THEN _
  1099.         GOTO 1502
  1100.      ON FF GOSUB _
  1101.          1550, _         'Autodownload
  1102.          4120, _         'Bulletin review on logon
  1103.         42960, _         'Case change
  1104.          4140, _         'File review on logon
  1105.          4100, _         'Line feeds
  1106.         42710, _         'Nulls
  1107.          4240, _         'Expert
  1108.          4200            'Bell
  1109.      ANS.INDEX = ANS.INDEX + 1
  1110.      IF ANS.INDEX > LAST.INDEX THEN _
  1111.         GOTO 1502
  1112.       GOTO 1510
  1113. 1550  IF AUTODOWNLOAD.DESIRED THEN _                                 ' CPC15-1B
  1114.          GOTO 1552                                                   ' CPC15-1B
  1115.       IF NOT AUTODOWNLOAD.VERIFIED THEN _                            ' CPC15-1B
  1116.          CALL TESTUSER                                               ' CPC15-1B
  1117.       IF NOT AUTODOWNLOAD.AVAILABLE THEN _                           ' CPC15-1B
  1118.          CALL QTPUT ("Your communications program does not support AUTODOWNLOAD",1) : _ ' CPC15-1B
  1119.          AUTODOWNLOAD.DESIRED = TRUE                                 ' CPC15-1B
  1120. 1552 AUTODOWNLOAD.DESIRED = NOT AUTODOWNLOAD.DESIRED                 ' CPC15-1B
  1121. 1560 A$ = "Autodownload "+MID$("offon",1-3*AUTODOWNLOAD.DESIRED,3)   ' CPC15-1B
  1122.      GOSUB 12979
  1123.      RETURN
  1124. '
  1125. ' *****************************************************************************
  1126. ' *  I - COMMAND FROM MAIN MENU (DISPLAY INITIAL WELCOME)                     *
  1127. ' *****************************************************************************
  1128. '
  1129. 1760 FILE.NAME$ = WELCOME.FILE$
  1130. 1765 GOSUB 1790
  1131.      RETURN
  1132. 1790 GOSUB 43030
  1133.      CALL BUFFILE (FILE.NAME$)
  1134.      CALL CARRIER
  1135.      IF SUBROUTINE.PARAMETER = -1 THEN _
  1136.         RETURN 10595
  1137.      RETURN
  1138. '
  1139. ' *****************************************************************************
  1140. ' *  C - COMMAND FROM MAIN MENU (LEAVE COMMENT FOR SYSOP)                     *
  1141. ' *****************************************************************************
  1142. '
  1143. 1800 A$ = "Leave a comment for " + _
  1144.           SYSOP.FIRST.NAME$ + _
  1145.           " (Y/N)"
  1146.      CALL SKIPLINE (1)
  1147.      GOSUB 12995
  1148.      RIGHT.MARGIN = 72
  1149.      IF NOT YES THEN _
  1150.         GOSUB 12979 : _
  1151.         RETURN
  1152. 1840 IF CONFERENCE.MODE AND _
  1153.         COMMENTS.AS.MESSAGES THEN _
  1154.         CALL QTPUT ("Comments can't be left in a Conference",1) : _
  1155.         RETURN
  1156.      IF CONFERENCE.MODE THEN _
  1157.         COMMENTS.IN.CONFERENCE = 1 : _
  1158.         IF ACTIVE.USER.NAME$ = "SYSOP" THEN _
  1159.            GOSUB 5350 _
  1160.         ELSE GOSUB 5360
  1161.      MESSAGE.TO$ = "SYSOP"
  1162.      SUBJECT$ = "COMMENT"
  1163.      IF (ACTIVE.MESSAGES > = MAXIMUM.MESSAGES OR _
  1164.          NEXT.MESSAGE.RECORD + 5 > HIGHEST.MESSAGE.RECORD OR _
  1165.          NOT COMMENTS.AS.MESSAGES ) THEN _
  1166.         A$ = SYSOP.FIRST.NAME$ + " UNABLE to reply.  Leave a comment? (Y/N)" : _
  1167.         GOSUB 12995 : _
  1168.         IF NOT YES THEN _
  1169.            GOSUB 12979 : _
  1170.            RETURN : _
  1171.         ELSE SYSOP.COMMENT = TRUE : _
  1172.              GOTO 2007
  1173.      SYSOP.COMMENT = FALSE
  1174.      SYSOP.MESSAGE = TRUE
  1175.      FT$ = "comment"
  1176.      GOTO 2010
  1177. 1850 CLOSE 2
  1178.      BX = &H3
  1179.      EN$ = COMMENTS.FILE$
  1180.      GOSUB 12992
  1181.      IF SHARE.IT THEN _
  1182.         OPEN COMMENTS.FILE$ FOR APPEND SHARED AS #2 _
  1183.      ELSE OPEN "A",2,COMMENTS.FILE$
  1184.      A$ = FIRST.NAME$ + ", Thanks for comments!"
  1185.      GOSUB 12976
  1186.      SUBROUTINE.PARAMETER = 2
  1187.      CALL AMORPM
  1188.      PRINT #2,ACTIVE.USER.NAME$,CURRENT.DATE$,TIM$,"Node ";NODE.ID$
  1189.      FOR X = 1 TO LINES.IN.MESSAGE
  1190.        PRINT #2,A$(X)
  1191.      NEXT
  1192.      PRINT #2,CARRIAGE.RETURN$
  1193.      CLOSE 2
  1194.      BX = &H3
  1195.      EN$ = COMMENTS.FILE$
  1196.      GOSUB 12993
  1197.      CALL UPDTCALR ("Left comment",1)
  1198.      REDIM A$(ADIM)
  1199.      RETURN
  1200. '
  1201. ' *****************************************************************************
  1202. ' *  P - COMMAND FROM MAIN MENU (DISPLAY PERSONAL MAIL)                       *
  1203. ' *****************************************************************************
  1204. '
  1205. 1900 CALL OPENMSG
  1206.      IF EC = 64 THEN _
  1207.         EC = 0 : _
  1208.         GOTO 5360
  1209.      FIELD 1, 128 AS MESSAGE.RECORD$
  1210.      SHOW.ACTIVE = FALSE
  1211.      IF NOT PRIVATE.DOOR THEN _
  1212.         A$ = "Checking messages in "+GRN$ : _
  1213.         GOSUB 12978 : _
  1214.         SHOW.ACTIVE = TRUE
  1215.      MESSAGES.FROM.USER = FALSE
  1216.      ACTIVE.MESSAGES = 0
  1217.      GOSUB 23000
  1218.      MESSAGE.RECORD = FIRST.MESSAGE.RECORD
  1219.      ACTIVE.DELAY! = 0
  1220.      MAXIMUM.MESSAGES = VAL(MID$(MESSAGE.RECORD$,89,7))
  1221.      IF MAXIMUM.MESSAGES > MM THEN _
  1222.         MAXIMUM.MESSAGES = MM
  1223.      REDIM M(MAXIMUM.MESSAGES,2)
  1224. 1905 GET 1,MESSAGE.RECORD
  1225.      NUMBER.RECORDS.IN.MESSAGE = VAL(MID$(MESSAGE.RECORD$,117,4))
  1226.      IF NUMBER.RECORDS.IN.MESSAGE < 1 THEN _
  1227.         NUMBER.RECORDS.IN.MESSAGE = 1
  1228. 1906 CALL FINDTIME (TI!)
  1229.      IF SHOW.ACTIVE AND TI! > ACTIVE.DELAY! THEN _
  1230.         A$ = "." : _
  1231.         GOSUB 12978 : _
  1232.         CALL FINDTIME (TI!) : _
  1233.         ACTIVE.DELAY! = TI! + 1
  1234. 1910 IF MESSAGE.RECORD >= NEXT.MESSAGE.RECORD THEN _
  1235.         LOW.MESSAGE.NUMBER = M(1,2) : _
  1236.         GOTO 1950
  1237. 1915 IF MID$(MESSAGE.RECORD$,116,1) = DELETED.MESSAGE$ OR _
  1238.         MID$(MESSAGE.RECORD$,116,1) <> ACTIVE.MESSAGE$ THEN _
  1239.         GOTO 1946
  1240. 1920 IF INSTR(MID$(MESSAGE.RECORD$,37,31),ACTIVE.USER.NAME$) OR _
  1241.         (SYSOP AND INSTR(MID$(MESSAGE.RECORD$,37,31),"SYSOP")) OR _
  1242.         (SYSOP AND INSTR(MID$(MESSAGE.RECORD$,37,31),SYSOP.FIRST.NAME$ + " " + SYSOP.LAST.NAME$)) THEN _
  1243.         GOTO 1925
  1244.      GOTO 1935
  1245. 1925 IF SHOW.ACTIVE THEN _
  1246.         CALL SKIPLINE (1) : _
  1247.         CALL QTPUT("Mail for YOU (* = Private)",1) : _
  1248.         SHOW.ACTIVE = FALSE
  1249. 1930 A$ = LEFT$(MESSAGE.RECORD$,5)
  1250.      GOSUB 12978
  1251. 1935 IF INSTR(MID$(MESSAGE.RECORD$,6,31),ACTIVE.USER.NAME$) OR _
  1252.         (SYSOP AND INSTR(MID$(MESSAGE.RECORD$,6,31),"SYSOP")) OR _
  1253.         (SYSOP AND INSTR(MID$(MESSAGE.RECORD$,6,31),SYSOP.FIRST.NAME$ + " " + SYSOP.LAST.NAME$)) THEN _
  1254.         GOTO 1940
  1255.      GOTO 1945
  1256. 1940 IF MESSAGES.FROM.USER < ADIM THEN _
  1257.         MESSAGES.FROM.USER = MESSAGES.FROM.USER + 1 : _
  1258.         B$(MESSAGES.FROM.USER) = LEFT$(MESSAGE.RECORD$,5)
  1259. 1945 ACTIVE.MESSAGES = ACTIVE.MESSAGES + 1
  1260.      M(ACTIVE.MESSAGES,1) = MESSAGE.RECORD
  1261.      M(ACTIVE.MESSAGES,2) = VAL(MID$(MESSAGE.RECORD$,2,4))
  1262. 1946 MESSAGE.RECORD = MESSAGE.RECORD + NUMBER.RECORDS.IN.MESSAGE
  1263.      GOTO 1905
  1264. 1950 IF SHOW.ACTIVE THEN _
  1265.         A$ = "Sorry, " + FIRST.NAME$ + ", NO MAIL for you" :_
  1266.         GOSUB 12975
  1267.      IF MESSAGES.FROM.USER = 0 OR NOT MESSAGE.REMINDER THEN _
  1268.         RETURN
  1269.      IF PRIVATE.DOOR THEN _
  1270.         GOTO 1961
  1271.      A$ = "Mail you left"
  1272.      GOSUB 12976
  1273. 1960 FOR I = 1 TO MESSAGES.FROM.USER
  1274.        A$ = B$(I)
  1275.        GOSUB 12978
  1276.      NEXT
  1277.      CALL SKIPLINE (1)
  1278.      CALL QTPUT("Please <K>ill old/unneeded messages",1)
  1279. 1961 REDIM B$(ADIM)
  1280.      RETURN
  1281. '
  1282. ' *****************************************************************************
  1283. ' *  E - COMMAND FROM MAIN MENU (ENTER MESSAGE)                               *
  1284. ' *****************************************************************************
  1285. '
  1286. 2000 IF LOW.MESSAGE.NUMBER > 0 AND _
  1287.         ACTIVE.MESSAGES = MAXIMUM.MESSAGES THEN _
  1288.         A$ = "No room for new messages!  Try tomorrow" : _
  1289.         GOSUB 12975 : _
  1290.         GOTO 3650
  1291. 2006 MESSAGE.PASSWORD$ = ""
  1292.      SYSOP.COMMENT = FALSE
  1293.      IF NOT REPLY THEN _
  1294.         MESSAGE.TO$ = ""
  1295. 2007 IF SYSOP.COMMENT THEN _
  1296.         Z$ = COMMENTS.FILE$ : _
  1297.         FT$ = "comment" _
  1298.      ELSE Z$ = ACTIVE.MESSAGE.FILE$ : _
  1299.           FT$ = "message"
  1300. 2008 IF SYSOP.COMMENT THEN _
  1301.         CALL FINDFREE : _
  1302.         GOTO 2009
  1303.      FREE.SPACE$ = "2000"
  1304.      IF NEXT.MESSAGE.RECORD + 3 >= HIGHEST.MESSAGE.RECORD THEN _
  1305.         FREE.SPACE$ = "1"
  1306. 2009 IF VAL(FREE.SPACE$) < 2000 THEN _
  1307.         A$ = "No room for " + FT$ : _
  1308.         GOSUB 12979 : _
  1309.         GOTO 3650
  1310. 2010 LINES.IN.MESSAGE = 0
  1311.      L = 0
  1312.      X = 0
  1313.      REDIM A$(ADIM)
  1314.      IF SYSOP.COMMENT THEN _
  1315.         GOTO 2100
  1316.      IF SYSOP.MESSAGE THEN _
  1317.         SYSOP.MESSAGE = FALSE : _
  1318.         GOTO 2077
  1319. 2020 IF REPLY THEN _
  1320.         GOTO 2060
  1321.      A$ = "To (Press [ENTER] for All)"
  1322.      CALL SKIPLINE (1)
  1323.      GOSUB 12995
  1324.      IF LEN(B$(1)) > 30 THEN _
  1325.         A$ = "30 Char. Max" : _
  1326.         GOSUB 12979 : _
  1327.         GOTO 2020
  1328. 2030 IF Q = 0 THEN _
  1329.         MESSAGE.TO$ = "ALL" _
  1330.      ELSE CALL ALLCAPSD (B$(),1) : _
  1331.           MESSAGE.TO$ = B$(1)
  1332.      IF Q > 0 AND _                                                  ' CPC15-1B
  1333.         LEN (B$(1)) < 2 THEN _                                       ' CPC15-1B
  1334.         CALL QTPUT ("Invalid user name!  Try again.",1) : _          ' CPC15-1B
  1335.         GOTO 2020                                                    ' CPC15-1B
  1336. 2035 A$ = "Subject"
  1337.      GOSUB 12995
  1338.      IF LEN(B$(1)) > 25 THEN _
  1339.         A$ = "25 Char. Max" : _
  1340.         GOSUB 12979 : _
  1341.         GOTO 2035
  1342. 2045 IF Q = 0 THEN _
  1343.         RETURN 1200
  1344.      CALL ALLCAPSD (B$(),1)
  1345.      SUBJECT$ = B$(1)
  1346. 2060 A$ = "Security: [K]ill, P)assword, R)eceiver, N)one, H)elp"
  1347.      GOSUB 12995
  1348.      IF Q = 0 THEN _
  1349.         B$(1) = "K"
  1350.      Z$ = LEFT$(B$(1),1)
  1351.      CALL ALLCAPS (Z$)
  1352.      ON INSTR("RKNPH",Z$) GOTO 2075,2090,2100,2075,2070
  1353.      GOTO 2060
  1354. '
  1355. ' *****************************************************************************
  1356. ' *  DISPLAY MESSAGE PROTECT HELP                                             *
  1357. ' *****************************************************************************
  1358. '
  1359. 2070 FILE.NAME$ = HELP$(3)
  1360.      GOSUB 1790
  1361.      GOTO 2060
  1362. '
  1363. ' *****************************************************************************
  1364. ' *  MAKE MESSAGE READ PROTECTED (ONLY ADDRESSEE AND SYSOP CAN READ IT)       *
  1365. ' *****************************************************************************
  1366. '
  1367. 2075 IF MESSAGE.TO$ = "ALL" THEN _
  1368.         CALL QTPUT("Message to ALL cannot be Receiver protected",1) : _
  1369.         GOTO 2060
  1370.      IF Z$ = "P" THEN _
  1371.         GOTO 2088
  1372. 2077 IF (START.HASH <> 1 OR INSTR(MESSAGE.TO$,"SYSOP") OR _
  1373.         START.INDIV <> 0 OR _                                        ' CPC15-1B
  1374.         ACTIVE.USER.NAME$ = "SYSOP" OR _
  1375.         INSTR(MESSAGE.TO$,SYSOP.FIRST.NAME$ + " " + SYSOP.LAST.NAME$)) THEN _
  1376.         GOTO 2081
  1377. 2079 IF NOT REPLY AND START.HASH = 1 THEN _
  1378.         TEMP.HASH.VALUE$ = MESSAGE.TO$ : _
  1379.         FOUND = FALSE : _
  1380.         SUIX = USER.FILE.INDEX : _
  1381.         USER.RECORD.HOLD$ = USER.RECORD$ : _                         ' CPC15-1B
  1382.         GOSUB 12600 : _
  1383.         USER.FILE.INDEX = SUIX : _
  1384.         LSET USER.RECORD$ = USER.RECORD.HOLD$ : _                    ' CPC15-1B
  1385.         GOSUB 12984 : _
  1386.         IF NOT FOUND THEN _
  1387.            A$ = MESSAGE.TO$ + " not active user" : _
  1388.            GOSUB 1397 : _
  1389.            GOTO 2020
  1390. 2081 A$ = "Sending personal mail to " + MESSAGE.TO$
  1391.      GOSUB 12979
  1392. 2084 MESSAGE.PASSWORD$ = "^READ^"
  1393.      GOTO 2100
  1394. 2085 A$ = "Password"
  1395.      GOSUB 12995
  1396.      IF Q = 0 THEN _
  1397.         GOTO 2085
  1398.      IF LEN(B$(1)) > L THEN _
  1399.         A$ = STR$(L) + " Chars. max" : _
  1400.         GOSUB 12979 : _
  1401.         GOTO 2085
  1402.      IF L = 15 AND MID$(B$(1),1,1) = "!" THEN _
  1403.         A$ = "Password can't begin with '!'" : _
  1404.         GOSUB 12979 : _
  1405.         GOTO 2085
  1406.      RETURN
  1407. '
  1408. ' *****************************************************************************
  1409. ' *  MAKE MESSAGE PASSWORD PROTECTED (USERS WITH PASSWORD AND SYSOP CAN READ) *
  1410. ' *****************************************************************************
  1411. '
  1412. 2088 A$ = "Receiver(s) Must KNOW PASSWORD TO READ msg.  Use password (Y/N)"
  1413.      GOSUB 12995
  1414.      IF NO THEN _
  1415.         GOTO 2070
  1416.      L = 14
  1417.      A1$ = "!"
  1418.      GOSUB 2085
  1419.      CALL ALLCAPSD (B$(),1)
  1420.      GOTO 2092
  1421. '
  1422. ' *****************************************************************************
  1423. ' *  MAKE MESSAGE KILL PROTECTED (ONLY SENDER, ADDRESSEE AND SYSOP CAN KILL)  *
  1424. ' *****************************************************************************
  1425. '
  1426. 2090 L = 15
  1427.      A1$ = ""
  1428.      B$(1) = "^KILL^"
  1429. 2092 MESSAGE.PASSWORD$ = A1$ + B$(1)
  1430. '
  1431. ' *****************************************************************************
  1432. ' *  ENTER MAIN BODY OF MESSAGE                                               *
  1433. ' *****************************************************************************
  1434. '
  1435. 2100 A$ = "Type " + _
  1436.           FT$ + _
  1437.           STR$(MAX.MESSAGE.LINES) + _
  1438.           " lines max" + PRESS.ENTER$
  1439.      GOSUB 12975
  1440.      GOSUB 3200
  1441. 2125 LINES.IN.MESSAGE = LINES.IN.MESSAGE + 1
  1442.      A$ = RIGHT$(STR$(LINES.IN.MESSAGE),2) + ": " + A$(LINES.IN.MESSAGE)
  1443.      GOSUB 12978
  1444.      CALL LINEEDIT(LINES.IN.MESSAGE,RIGHT.MARGIN+1)
  1445.      IF WAIT.EXPIRED THEN _
  1446.         GOTO 10590_
  1447.      ELSE IF SUBROUTINE.PARAMETER = -1 THEN _
  1448.         GOTO 10595
  1449.      GOSUB 60000
  1450.      IF A$(LINES.IN.MESSAGE) = "" THEN _
  1451.         LINES.IN.MESSAGE = LINES.IN.MESSAGE-1 : _
  1452.         GOTO 2300
  1453. 2140 J = LINES.IN.MESSAGE
  1454.      GOSUB 2200
  1455.      IF X THEN _
  1456.         GOTO 2300
  1457.      GOTO 2125
  1458. 2200 X = 0
  1459.      IF J < (MAX.MESSAGE.LINES-2) THEN _
  1460.         RETURN
  1461.      A$ = MID$("2 lines leftLast line   Full",12*(J-(MAX.MESSAGE.LINES-2)) + 1,12)
  1462.      X = (J > (MAX.MESSAGE.LINES-1))
  1463. 2210 GOSUB 12979
  1464.      RETURN
  1465. '
  1466. ' *****************************************************************************
  1467. ' *  FINAL MESSAGE DISPOSITION                                                *
  1468. ' *****************************************************************************
  1469. '
  1470. 2300 GOSUB 12979
  1471.      IF NOT EXPERT.USER THEN _
  1472.         GOSUB 50400
  1473. 2315 A$ = "Edit Sub-function <A,C,D,E,I,L,M,S,?>"
  1474.      CALL SKIPLINE (1)
  1475.      GOSUB 12995
  1476.      IF Q = 0 THEN _
  1477.         GOTO 2315
  1478.      CALL ALLCAPSD (B$(),1)
  1479.      Z$ = B$(1)
  1480. 2325 IF Q > 1 AND Z$ <> "M" THEN _
  1481.         L = VAL(B$(Q)) : _
  1482.         GOSUB 3320
  1483. 2330 ON INSTR("ACDEILMS?",Z$) GOTO 2400,2340,2500,2600,2800,3000,3100,3400,2345
  1484.      GOTO 2300
  1485. '
  1486. ' *****************************************************************************
  1487. ' *  CONTINUE ENTERING MESSAGE                                                *
  1488. ' *****************************************************************************
  1489. '
  1490. 2340 GOSUB 3200
  1491.      GOTO 2140
  1492. '
  1493. ' *****************************************************************************
  1494. ' *  DISPLAY MESSAGE SUBCOMMANDS HELP FILE                                    *
  1495. ' *****************************************************************************
  1496. '
  1497. 2345 FILE.NAME$ = HELP$(4)
  1498.      GOSUB 1790
  1499.      GOTO 2315
  1500. '
  1501. ' *****************************************************************************
  1502. ' *  ABORT MESSAGE                                                            *
  1503. ' *****************************************************************************
  1504. '
  1505. 2400 A$ = "Abort " + FT$ + " (Y/N)"
  1506.      CALL SKIPLINE (1)
  1507.      GOSUB 12995
  1508.      IF NOT YES THEN _
  1509.         GOTO 2300
  1510. 2430 A$ = "Aborted"
  1511.      GOSUB 12975
  1512.      GOTO 3650
  1513. '
  1514. ' *****************************************************************************
  1515. ' *  DELETE MESSAGE LINE                                                      *
  1516. ' *****************************************************************************
  1517. '
  1518. 2500 GOSUB 12979
  1519.      IF Q = 1 THEN _
  1520.         A$ = "Delete " : _
  1521.         GOSUB 12978 : _
  1522.         GOSUB 3300
  1523. 2520 A$ = "Line #" + STR$(L)
  1524.      GOSUB 12979
  1525.      A$ = A$(L)
  1526.      GOSUB 12977
  1527.      A$ = "Delete this line (Y/N)"
  1528.      GOSUB 12995
  1529.      IF NOT YES THEN _
  1530.         A$ = "NOT Deleted" : _
  1531.         GOSUB 12979 : _
  1532.         GOTO 2300
  1533. 2550 LINES.IN.MESSAGE = LINES.IN.MESSAGE-1
  1534.      FOR X = L TO LINES.IN.MESSAGE
  1535.        A$(X) = A$(X + 1)
  1536.      NEXT
  1537.      A$(LINES.IN.MESSAGE + 1) = ""
  1538.      A$ = "Deleted Line #" + STR$(L)
  1539.      GOSUB 12979
  1540.      GOTO 2300
  1541. '
  1542. ' *****************************************************************************
  1543. ' *  EDIT MESSAGE LINE                                                        *
  1544. ' *****************************************************************************
  1545. '
  1546. 2600 GOSUB 12979
  1547.      IF Q = 1 THEN _
  1548.         GOSUB 3300
  1549. 2620 A$ = "Line #" + STR$(L) + " is:" + RETURN.LINE.FEED$ + A$(L)
  1550.      GOSUB 12977
  1551.      IF NOT EXPERT.USER THEN _
  1552.         CALL QTPUT ("Search & replace",1)
  1553.      A$ = "Search for ([ENTER] quits)"
  1554.      GOSUB 12995
  1555.      IF Q = 0 THEN _
  1556.         GOTO 2300
  1557.      X$ = B$(1)
  1558.      IF Q > 1 THEN _
  1559.         Y$ = B$(2): _
  1560.         GOTO 2660
  1561.      A$="And replace by"
  1562.      GOSUB 12995
  1563.      Y$ = B$(1)
  1564. 2660 X = INSTR(1,A$(L),X$)
  1565.      IF X = 0 THEN _
  1566.         GOTO 2710
  1567. 2670 FF = LEN(X$)
  1568.      JJ = LEN(Y$)
  1569.      IF FF = JJ THEN _
  1570.         MID$(A$(L),X) = Y$ : _
  1571.         GOTO 2620
  1572. 2690 DF$ = LEFT$(A$(L),X-1)
  1573.      A$(L) = DF$ + Y$ + MID$(A$(L),X + FF)
  1574.      GOTO 2620
  1575. 2710 A$ = "String <" + X$ + "> not found in line" + STR$(L)
  1576.      GOSUB 12979
  1577.      GOTO 2300
  1578. '
  1579. ' *****************************************************************************
  1580. ' *  INSERT MESSAGE LINE                                                      *
  1581. ' *****************************************************************************
  1582. '
  1583. 2800 IF LINES.IN.MESSAGE >= MAX.MESSAGE.LINES AND NOT SYSOP THEN _
  1584.         A$ = "Message full" : _
  1585.         GOSUB 12979 : _
  1586.         GOTO 2920
  1587. 2820 GOSUB 12979
  1588.      IF Q = 1 THEN _
  1589.         A$ = "Before " : _
  1590.         GOSUB 12978 : _
  1591.         GOSUB 3300
  1592. 2830 LL = LINES.IN.MESSAGE
  1593.      K = LINES.IN.MESSAGE-L
  1594.      FOR X = L TO LINES.IN.MESSAGE
  1595.        B$(X + 1-L) = A$(X)
  1596.        A$(X) = ""
  1597.      NEXT
  1598.      LINES.IN.MESSAGE = L
  1599. 2840 A$ = RIGHT$(STR$(LINES.IN.MESSAGE),2) + ": "
  1600.      GOSUB 12978
  1601.      CALL LINEEDIT(LINES.IN.MESSAGE,RIGHT.MARGIN+1)
  1602.      IF A$(LINES.IN.MESSAGE) = "" THEN _
  1603.         GOTO 2920
  1604. 2870 LINES.IN.MESSAGE = LINES.IN.MESSAGE + 1
  1605.      J = LINES.IN.MESSAGE + K-1
  1606.      GOSUB 2200
  1607.      IF NOT X THEN _
  1608.         GOTO 2840
  1609. 2920 FOR X = 1 TO K + 1
  1610.        A$(LINES.IN.MESSAGE + X-1) = B$(X)
  1611.      NEXT
  1612.      REDIM B$(ADIM)
  1613.      LINES.IN.MESSAGE = LL + LINES.IN.MESSAGE-L
  1614.      GOTO 2300
  1615. '
  1616. ' *****************************************************************************
  1617. ' *  LIST MESSAGE CONTENTS                                                    *
  1618. ' *****************************************************************************
  1619. '
  1620. 3000 STOP.INTERRUPTS = TRUE
  1621.      GOSUB 12979
  1622.      IF Q = 1 THEN _
  1623.         L = 1 : _
  1624.         A$ = "To: " + MESSAGE.TO$ + " Re: " + SUBJECT$ : _
  1625.         GOSUB 12979 : _
  1626.         GOSUB 3200
  1627. 3020 FOR X = L TO LINES.IN.MESSAGE
  1628.        IF RET THEN _
  1629.           GOTO 2300 _
  1630.        ELSE A$ = RIGHT$(STR$(X),2) + ": " + A$(X)
  1631. 3030   GOSUB 12979
  1632.      NEXT
  1633.      GOTO 2300
  1634. '
  1635. ' *****************************************************************************
  1636. ' *  CHANGE MARGIN WIDTH                                                      *
  1637. ' *****************************************************************************
  1638. '
  1639. 3100 GOSUB 12979
  1640.      IF Q <> 1 THEN _
  1641.         B$(1) = B$(Q) : _
  1642.         GOTO 3130
  1643. 3115 A$ = "SET Right-Margin from" + STR$(RIGHT.MARGIN) + " TO (8...72)"
  1644.      GOSUB 12995
  1645.      IF LEN(B$(1)) > 2 THEN _
  1646.         GOTO 3140
  1647. 3130 X = VAL(B$(1))
  1648.      IF X > 7 AND X < 73 THEN _
  1649.         RIGHT.MARGIN = X : _
  1650.         A$ = "Margin now" + STR$(RIGHT.MARGIN) : _
  1651.         GOTO 3150
  1652. 3140 A$ = "Invalid - Margin UNCHANGED"
  1653. 3150 GOSUB 12979
  1654.      IF UTILITY.MARGIN.CHANGE THEN _
  1655.         RETURN
  1656.      GOTO 2300
  1657. 3200 A$ = "    [" + STRING$(RIGHT.MARGIN-2,45) + "]"
  1658.      GOSUB 12975
  1659.      RETURN
  1660. 3300 A$ = "Line #"
  1661.      GOSUB 12995
  1662.      L = VAL(B$(1))
  1663. 3320 IF L >= 1 AND L <= LINES.IN.MESSAGE THEN _
  1664.         RETURN
  1665. 3330 IF Q = 0 THEN _
  1666.         RETURN 2300
  1667. 3340 A$ = "No such line"
  1668.      GOSUB 12979
  1669.      RETURN 2300
  1670. '
  1671. ' *****************************************************************************
  1672. ' *  SAVE MESSAGE                                                             *
  1673. ' *****************************************************************************
  1674. '
  1675. 3400 IF SYSOP.COMMENT THEN _
  1676.         GOTO 1850
  1677. 3405 GOSUB 4910
  1678.      MESSAGE.RECORD.SAVE$ = MESSAGE.RECORD$
  1679.      A$ = "Adding new msg #" + STR$(HIGH.MESSAGE.NUMBER + 1)
  1680.      IF NOT LOCAL.USER THEN _
  1681.         CALL UPDTCALR (A$,1)
  1682.      GOSUB 12978
  1683.      SL = 0
  1684.      N$ = ""
  1685.      IF LOW.MESSAGE.NUMBER = 0 THEN _
  1686.         LOW.MESSAGE.NUMBER = 1 : _
  1687.         HIGH.MESSAGE.NUMBER = 1 : _
  1688.         GOTO 3410
  1689.      HIGH.MESSAGE.NUMBER = HIGH.MESSAGE.NUMBER + 1
  1690. 3410 ACTIVE.MESSAGES = ACTIVE.MESSAGES + 1
  1691.      MESSAGE.NUMBER$ = STR$(HIGH.MESSAGE.NUMBER) + _
  1692.                        SPACE$(5-LEN(STR$(HIGH.MESSAGE.NUMBER)))
  1693.      IF MESSAGE.PASSWORD$ = "^READ^" THEN _
  1694.         MID$(MESSAGE.NUMBER$,1,1) = "*"
  1695. 3460 MESSAGE.FROM$ = ACTIVE.USER.NAME$ + SPACE$(31-LEN(ACTIVE.USER.NAME$))
  1696.      MESSAGE.TO$ = MESSAGE.TO$ + SPACE$(31-LEN(MESSAGE.TO$))
  1697.      MID$(MESSAGE.TO$,23,8) = TIME$
  1698.      SUBJECT$ = SUBJECT$ + SPACE$(25-LEN(SUBJECT$))
  1699.      MESSAGE.PASSWORD$ = MESSAGE.PASSWORD$ + SPACE$(15-LEN(MESSAGE.PASSWORD$))
  1700.      FOR J = 1 TO LINES.IN.MESSAGE
  1701.        A$(J) = A$(J) + CHR$(227)
  1702.        SL = SL + LEN(A$(J))
  1703.      NEXT
  1704.      IF SL MOD 128 = 0 THEN _
  1705.         N$ = STR$(SL\128 + 1) _
  1706.      ELSE N$ = STR$(SL\128 + 2)
  1707. 3530 GET 1,NEXT.MESSAGE.RECORD
  1708.      M(ACTIVE.MESSAGES,1) = NEXT.MESSAGE.RECORD
  1709.      M(ACTIVE.MESSAGES,2) = HIGH.MESSAGE.NUMBER
  1710.      LSET MESSAGE.RECORD$ = MESSAGE.NUMBER$ + _
  1711.                             MESSAGE.FROM$ + _
  1712.                             MESSAGE.TO$ + _
  1713.                             CURRENT.DATE$ + _
  1714.                             SUBJECT$ + _
  1715.                             MESSAGE.PASSWORD$ + _
  1716.                             ACTIVE.MESSAGE$ + _
  1717.                             N$
  1718.      PUT 1,NEXT.MESSAGE.RECORD
  1719.      NEXT.MESSAGE.RECORD = NEXT.MESSAGE.RECORD + VAL(N$)
  1720.      N$ = ""
  1721.      FOR J = 1 TO LINES.IN.MESSAGE
  1722.        A$ = "."
  1723.        GOSUB 12978
  1724.        N$ = N$ + A$(J)
  1725.        IF LEN(N$) > 127 THEN _
  1726.           LSET MESSAGE.RECORD$ = N$ : _
  1727.           PUT 1 : _
  1728.           N$ = MID$(N$,129)
  1729. 3630 NEXT
  1730.      IF LEN(N$) > 0 THEN _
  1731.         LSET MESSAGE.RECORD$ = N$ : _
  1732.         PUT 1
  1733.      REDIM A$(ADIM)
  1734. 3640 GOSUB 12979
  1735.      LSET MESSAGE.RECORD$ = MESSAGE.RECORD.SAVE$
  1736.      GOSUB 24000
  1737.      GOSUB 12985
  1738. 3650 IF REPLY THEN _
  1739.         CALL OPENMSG : _
  1740.         IF EC = 64 THEN _
  1741.            EC = 0 : _
  1742.            GOTO 5360 : _
  1743.         ELSE FIELD 1, 128 AS MESSAGE.RECORD$ : _
  1744.         RETURN
  1745.      RETURN 1200
  1746. '
  1747. ' *****************************************************************************
  1748. ' *  K - COMMAND FROM MAIN MENU (KILL MESSAGE)                                *
  1749. ' *****************************************************************************
  1750. '
  1751. 3900 KILL.MESSAGE = FALSE
  1752.      GOSUB 12979
  1753.      IF Q <> 1 THEN _
  1754.         MESSAGE.TO.KILL = VAL(B$(Q)) : _
  1755.         GOTO 3950
  1756. 3930 A$ = "Msg # to Kill"
  1757.      GOSUB 12995
  1758.      IF Q = 0 THEN _
  1759.         RETURN
  1760.      MESSAGE.TO.KILL = VAL(B$(Q))
  1761.      GOSUB 12979
  1762. 3950 CALL OPENMSG
  1763.      IF EC = 64 THEN _
  1764.         EC = 0 : _
  1765.      FIELD 1, 128 AS MESSAGE.RECORD$
  1766.      CALL KILLMSG (MESSAGE.TO.KILL,ACTIVE.MESSAGES)
  1767. 4040 IF KILL.MESSAGE THEN _
  1768.         RETURN
  1769.      RETURN 1200
  1770. '
  1771. ' *****************************************************************************
  1772. ' *  L - COMMAND FROM UTILITY MENU (LINE FEEDS TOGGLE)                        *
  1773. ' *****************************************************************************
  1774. '
  1775. 4100 LINE.FEEDS = NOT LINE.FEEDS
  1776.      IF LOCAL.USER THEN _
  1777.         LINE.FEEDS = TRUE
  1778.      A$ = "Line Feeds " + MID$("OffOn",1-3*LINE.FEEDS,3)
  1779.      CALL SETCRLF
  1780.      GOSUB 12979
  1781.      RETURN
  1782. '
  1783. ' ***************************************************************
  1784. ' *     TOGGLE WHETHER BULLETINS SKIPPED ON LOGON IF NONE NEW   *
  1785. ' ***************************************************************
  1786. '
  1787. 4120 CHECK.BULLETIN.LOGON = NOT CHECK.BULLETIN.LOGON
  1788.      A$ = MID$("SKIP CHECK",1-5*CHECK.BULLETIN.LOGON,5) + _
  1789.           " old BULLETINS in logon"
  1790.      GOSUB 12979
  1791.      RETURN
  1792. '
  1793. ' ***************************************************************
  1794. ' *     TOGGLE WHETHER SKIP NEW FILE DOWNLOAD ON LOGON          *
  1795. ' ***************************************************************
  1796. '
  1797. 4140 SKIP.FILES.LOGON = NOT SKIP.FILES.LOGON
  1798.      A$ = MID$("CHECKSKIP ",1-5*SKIP.FILES.LOGON,5) + _
  1799.           " new files in logon"
  1800.      GOSUB 12979
  1801.      RETURN
  1802. 4200 PROMPT.BELL = NOT PROMPT.BELL
  1803.      A$ = "Prompt Bell " + MID$("OffOn",1-3*PROMPT.BELL,3)
  1804.      GOSUB 12979
  1805.      RETURN
  1806. '
  1807. ' *****************************************************************************
  1808. ' *  X - COMMAND EXPERT TOGGLE (GLOBAL)                                       *
  1809. ' *****************************************************************************
  1810. '
  1811. 4240 EXPERT.USER = NOT EXPERT.USER
  1812.      A$ = MID$("NoviceExpert",1-6*EXPERT.USER,6)
  1813.      GOSUB 12979
  1814.      RETURN
  1815. '
  1816. ' *****************************************************************************
  1817. ' *  T)opic - QUICK SCAN MESSAGES                                             *
  1818. ' *****************************************************************************
  1819. '
  1820. 4320 QUICK.SCAN.MESSAGES = TRUE
  1821.      READ.MESSAGES = FALSE
  1822.      SCAN.MESSAGES = FALSE
  1823.      GOTO 4350
  1824. '
  1825. ' *****************************************************************************
  1826. ' *  R - COMMAND FROM MAIN MENU (READ MESSAGES)                               *
  1827. ' *****************************************************************************
  1828. '
  1829. 4330 QUICK.SCAN.MESSAGES = FALSE
  1830.      READ.MESSAGES = TRUE
  1831.      SCAN.MESSAGES = FALSE
  1832.      IF NOT LOCAL.USER THEN _
  1833.         CALL UPDTCALR ("Read Messages...",1)
  1834.      GOSUB 1300
  1835.      GOTO 4350
  1836. '
  1837. ' *****************************************************************************
  1838. ' *  S - COMMAND FROM MAIN MENU (SCAN MESSAGE HEADERS)                        *
  1839. ' *****************************************************************************
  1840. '
  1841. 4340 IF Q < 2 THEN _
  1842.         GOSUB 1300
  1843. 4345 QUICK.SCAN.MESSAGES = FALSE
  1844.      READ.MESSAGES = FALSE
  1845.      SCAN.MESSAGES = TRUE
  1846. '
  1847. ' *****************************************************************************
  1848. ' *  MESSAGE READ MAINLINE (QUICK SCAN, READ & SCAN) ALL USE THIS ROUTINE     *
  1849. ' *****************************************************************************
  1850. '
  1851. 4350 CALL OPENMSG
  1852.      IF EC = 64 THEN _
  1853.         EC = 0 : _
  1854.         GOTO 5360
  1855.      FIELD 1,128 AS MESSAGE.RECORD$
  1856.      IF Q > 2 AND INSTR(B$(Q),"*") THEN _
  1857.         Z$ = "" : _
  1858.         GOTO 4360
  1859.      IF Q > 2 AND VAL(B$(Q)) = 0 THEN _
  1860.         Z$ = B$(Q) : _
  1861.         CALL ALLCAPS (Z$) : _
  1862.         Q = Q-1 _
  1863.      ELSE Z$ = ""
  1864. 4360 LG$(11) = Z$
  1865.      MESSAGES.SELECTED.INDEX = 1
  1866.      NUMBER.MESSAGES.SELECTED = Q
  1867.      ADDRESSED.TO.USER = FALSE
  1868.      NON.STOP = (PAGE.LENGTH < 1)
  1869. 4370 MESSAGES.SELECTED.INDEX = MESSAGES.SELECTED.INDEX  + 1
  1870. 4371 IF MESSAGES.SELECTED.INDEX <= NUMBER.MESSAGES.SELECTED THEN _
  1871.         CURRENT.MESSAGE = VAL(B$(MESSAGES.SELECTED.INDEX)) : _
  1872.         GOTO 4415
  1873. 4380 NON.STOP = FALSE
  1874.      ADDRESSED.TO.USER = FALSE
  1875.      A$ = "Msg # (" + _
  1876.            STR$(LOW.MESSAGE.NUMBER) + _
  1877.            " to" + _
  1878.            STR$(M(ACTIVE.MESSAGES,2)) + _
  1879.            ", *, <H>elp)"
  1880.      IF EXPERT.USER THEN _
  1881.         GOTO 4400
  1882. 4390 IF READ.MESSAGES THEN _
  1883.         A$ = A$ + " to Retrieve"+PRESS.ENTER$ _
  1884.      ELSE A$ = "Starting at " + A$
  1885. 4400 GOSUB 12995
  1886.      IF Q = 0 THEN _
  1887.         RETURN
  1888.      IF INSTR("Hh",LEFT$(B$(1),1)) THEN _
  1889.         FILE.NAME$ = HELP$(7) : _
  1890.         GOSUB 1790 : _
  1891.         RETURN
  1892.      MESSAGES.SELECTED.INDEX = 0
  1893.      NUMBER.MESSAGES.SELECTED = Q
  1894.      GOTO 4370
  1895. 4415 FORWARD = FALSE
  1896.      REVERSE = FALSE
  1897.      IF B$(MESSAGES.SELECTED.INDEX) = "*" THEN _
  1898.         CURRENT.MESSAGE = LAST.MESSAGE.READ + 1 : _
  1899.         FORWARD = TRUE : _
  1900.         GOTO 4430
  1901. 4416 IF INSTR("Mm",B$(MESSAGES.SELECTED.INDEX)) THEN _
  1902.         ADDRESSED.TO.USER = TRUE : _
  1903.         GOTO 4370
  1904.      IF CURRENT.MESSAGE = 0 THEN _
  1905.         RETURN
  1906.      GOSUB 12979
  1907. 4430 IF RIGHT$(B$(MESSAGES.SELECTED.INDEX),1) = "+" THEN _
  1908.         FORWARD = TRUE
  1909.      IF RIGHT$(B$(MESSAGES.SELECTED.INDEX),1) = "-" THEN _
  1910.         REVERSE = TRUE : _
  1911.         GOTO 4490
  1912. 4450 MESSAGE.DIM.INDEX = 1
  1913. 4452 IF MESSAGE.DIM.INDEX > ACTIVE.MESSAGES THEN _
  1914.         GOTO 4515
  1915.      IF READ.MESSAGES AND _
  1916.         M(MESSAGE.DIM.INDEX,2) = CURRENT.MESSAGE THEN _
  1917.         GOTO 4520
  1918. 4470 IF ((READ.MESSAGES AND FORWARD) OR _
  1919.         QUICK.SCAN.MESSAGES OR SCAN.MESSAGES) AND _
  1920.         M(MESSAGE.DIM.INDEX,2)  >= CURRENT.MESSAGE THEN _
  1921.         GOTO 4520
  1922. 4480 MESSAGE.DIM.INDEX = MESSAGE.DIM.INDEX + 1
  1923.      GOTO 4452
  1924. 4490 MESSAGE.DIM.INDEX = ACTIVE.MESSAGES
  1925. 4492 IF MESSAGE.DIM.INDEX < 1 THEN _
  1926.         GOTO 4515
  1927.      IF M(MESSAGE.DIM.INDEX,2) <= CURRENT.MESSAGE THEN _
  1928.         GOTO 4540
  1929. 4510 MESSAGE.DIM.INDEX = MESSAGE.DIM.INDEX - 1
  1930.      GOTO 4492
  1931. 4515 A$ = "No such msg #" + STR$(CURRENT.MESSAGE)
  1932.      GOSUB 12979
  1933.      GOTO 4370
  1934. 4520 ENDING.MESSAGE.INDEX = MESSAGE.DIM.INDEX
  1935.      IF READ.MESSAGES AND NOT FORWARD THEN _
  1936.         GOTO 4560
  1937. 4530 STARTING.MESSAGE.INDEX = MESSAGE.DIM.INDEX
  1938.      ENDING.MESSAGE.INDEX = ACTIVE.MESSAGES
  1939.      SO = 1
  1940.      GOTO 4550
  1941. 4540 STARTING.MESSAGE.INDEX = MESSAGE.DIM.INDEX
  1942.      ENDING.MESSAGE.INDEX = 1
  1943.      SO = -1
  1944. 4550 XXX = ENDING.MESSAGE.INDEX + SO
  1945.      MESSAGE.DIM.INDEX = STARTING.MESSAGE.INDEX
  1946. 4552 IF MESSAGE.DIM.INDEX = XXX THEN _
  1947.         GOTO 4637
  1948. 4560   GET 1,M(MESSAGE.DIM.INDEX,1)
  1949.        PASSWORD.FAILED = 0
  1950.        UH = 0
  1951.        Z$ = MID$(MESSAGE.RECORD$,101,15)
  1952.        X = 1
  1953. 4561   FF = INSTR(MID$(MESSAGE.RECORD$,X),ACTIVE.USER.NAME$)
  1954.        IF FF > 0 THEN _
  1955.           X = LEN(ACTIVE.USER.NAME$) + FF : _
  1956.           IF (FF < 7 OR MID$(MESSAGE.RECORD$,FF-1,1) = " ") AND (X > 66 OR MID$(MESSAGE.RECORD$,X,1) = " ") THEN _
  1957.              UH = TRUE _
  1958.           ELSE IF FF < 37 THEN _
  1959.                   X = 37 : _
  1960.                   GOTO 4561
  1961. 4562   IF NOT SYSOP THEN _
  1962.           IF INSTR(MESSAGE.RECORD$,"^READ^") > 0 AND NOT UH THEN _
  1963.              PASSWORD.FAILED = TRUE : _
  1964.              IF FORWARD OR REVERSE THEN _
  1965.                 GOTO 4635
  1966. 4563   CURRENT.MESSAGE = VAL(MID$(MESSAGE.RECORD$,2,4))
  1967.        IF ADDRESSED.TO.USER AND NOT UH THEN _
  1968.           GOTO 4625
  1969. 4580   IF INSTR(MESSAGE.RECORD$,LG$(11)) = 0 THEN _
  1970.           GOTO 4635
  1971. 4581   IF MID$(MESSAGE.RECORD$,116,1) = DELETED.MESSAGE$ THEN _
  1972.           GOTO 4630
  1973. 4582   PG = FALSE
  1974.        IF MID$(Z$,1,1) = "!" THEN _
  1975.           IF NOT SYSOP THEN _
  1976.              PG = TRUE : _
  1977.              PASSWORD.SAVE$ = MID$(Z$,2) + " " : _
  1978.              ATTEMPTS.ALLOWED = 0 : _
  1979.              GOSUB 665
  1980. 4584   IF PASSWORD.FAILED AND _
  1981.           (QUICK.SCAN.MESSAGES OR (SCAN.MESSAGES AND NOT PG)) THEN _
  1982.           GOTO 4635
  1983. 4585   IF PASSWORD.FAILED THEN _
  1984.           IF PG THEN _
  1985.              SJ$ = "<PASSWORD>" _
  1986.           ELSE SJ$ = "<PROTECTED>" _
  1987.        ELSE SJ$ = MID$(MESSAGE.RECORD$,76,25)
  1988. 4590   IF QUICK.SCAN.MESSAGES THEN _
  1989.           A$ = LEFT$(MESSAGE.RECORD$,5) : _
  1990.           A$ = LEFT$(A$ + SPACE$(2),INSTR(A$ +SPACE$(2),SPACE$(2))-1) : _
  1991.           A$ = A$ + " " + SJ$ : _
  1992.           GOSUB 12979 : _
  1993.           GOTO 4630
  1994. 4600   GOSUB 8000
  1995.        IF SCAN.MESSAGES OR RET THEN _
  1996.           GOTO 4630
  1997.        IF M(MESSAGE.DIM.INDEX,2) > LAST.MESSAGE.READ THEN _
  1998.           LAST.MESSAGE.READ = M(MESSAGE.DIM.INDEX,2)
  1999. 4610   IF NOT PASSWORD.FAILED THEN _
  2000.           GOTO 4613
  2001.        IF PG THEN _
  2002.           ATTEMPTS.ALLOWED = 2 : _
  2003.           GOSUB 667
  2004. 4611   IF PASSWORD.FAILED THEN _
  2005.           GOTO 4625
  2006. 4613   GOSUB 9000
  2007.        CALL SKIPLINE (1)
  2008. 4614   GOSUB 41000
  2009.        KILL.MESSAGE = FALSE
  2010.        REPLY = FALSE
  2011.        IF NON.STOP THEN _
  2012.           GOTO 4625
  2013. 4616   IF EXPERT.USER THEN _
  2014.          A$ = "More [Y],N,NS,RE" + MID$(",K",1,-UH*2)_
  2015.        ELSE A$ = "MORE [Y]es,N)o,NS)non-stop,RE)ply" + _
  2016.             MID$(",K)ill",1,-UH*7)
  2017.        NO.ADVANCE = TRUE
  2018.        GOSUB 12995
  2019.        CALL WIPELINE (43)
  2020.        IF NO THEN _
  2021.           GOTO 4650
  2022. '
  2023. ' *****************************************************************************
  2024. ' *  KILL CURRENT MESSAGE                                                     *
  2025. ' *****************************************************************************
  2026. '
  2027. 4618   IF KILL.MESSAGE AND (UH OR SYSOP) THEN _
  2028.           IF USER.SECURITY.LEVEL >= OPT.SEC(9) THEN _
  2029.              GOSUB 62520 : _
  2030.              MESSAGE.TO.KILL = CURRENT.MESSAGE : _
  2031.              GOSUB 3950 : _
  2032.              GOSUB 62530 : _
  2033.              GOTO 4625 _
  2034.           ELSE VIOLATION$ = "MORE KILL" : _
  2035.                GOSUB 1380 : _
  2036.                GOTO 4625
  2037. '
  2038. ' *****************************************************************************
  2039. ' *  REPLY TO CURRENT MESSAGE                                                 *
  2040. ' *****************************************************************************
  2041. '
  2042. 4620   IF NOT REPLY THEN _
  2043.           GOTO 4625
  2044. 4621   IF USER.SECURITY.LEVEL < OPT.SEC(5) THEN _
  2045.           VIOLATION$ = "MORE RE" : _
  2046.           GOSUB 1380 : _
  2047.           REPLY = FALSE : _
  2048.           GOTO 4625
  2049.        IF LEFT$(SUBJECT$,3) <> "(R)" THEN _
  2050.           SUBJECT$ = "(R)" + LEFT$(SUBJECT$,22)
  2051. 4622   MESSAGE.TO$ = MESSAGE.FROM$
  2052.        MESSAGE.FROM$ = ACTIVE.USER.NAME$
  2053.        GOSUB 62520
  2054.        GOSUB 2000
  2055.        REPLY = FALSE
  2056.        GOSUB 62530
  2057.        GOTO 4560
  2058. 4625   IF NOT FORWARD AND NOT REVERSE THEN _
  2059.           GOTO 4370
  2060. 4630   GOSUB 57110
  2061. 4631   CALL CARRIER
  2062.        IF SUBROUTINE.PARAMETER THEN _
  2063.           RETURN 10595
  2064.        IF RET THEN _
  2065.           RETURN
  2066. 4635 IF SO = 0 THEN _
  2067.         SO = 1
  2068.      MESSAGE.DIM.INDEX = MESSAGE.DIM.INDEX + SO
  2069.      GOTO 4552
  2070. 4637 IF READ.MESSAGES THEN _
  2071.         GOTO 4370
  2072. 4650 GOSUB 12979
  2073.      CALL QTPUT ("End of Messages",1)
  2074.      RETURN
  2075. '
  2076. ' *****************************************************************************
  2077. ' *  O - COMMAND FROM MAIN MENU (OPERATOR PAGE)                               *
  2078. ' *****************************************************************************
  2079. '
  2080. 4700 IF NOT SYSOP.AVAILABLE THEN _
  2081.         GOTO 4708
  2082. 4705 CALL QTPUT ("Chat. Remote Conversation",1)
  2083.      JJ = VAL(MID$(TIME$,1,2))*100 + VAL(MID$(TIME$,4,2))
  2084.      IF (JJ > START.OFFICE.HOURS AND JJ < END.OFFICE.HOURS) OR SYSOP.ANNOY THEN _
  2085.         GOTO 4710
  2086. 4707 GOTO 4750
  2087. 4708 A$ = "SYSOP in from" + _
  2088.           STR$(START.OFFICE.HOURS) + _
  2089.           " to" + _
  2090.           STR$(END.OFFICE.HOURS) + ","
  2091.      GOSUB 12979
  2092.      GOTO 4755
  2093. 4710 A$ = "Page " + SYSOP.FIRST.NAME$ + " ([Y]/N)"
  2094.      CALL SKIPLINE (1)
  2095.      GOSUB 12995
  2096.      IF NO THEN _
  2097.         RETURN
  2098.      PAGE.COUNT = 0
  2099.      A$ = "Paging " + SYSOP.FIRST.NAME$ + " now"
  2100.      GOSUB 12978
  2101.      CALL FINDTIME (PAGE.TIME.MAX!)
  2102.      PAGE.TIME.MAX! = PAGE.TIME.MAX! + 30
  2103. 4730 CALL DELAYIT (1)
  2104. 4735 PAGE.COUNT = PAGE.COUNT + 1
  2105.      IF INKEY$ = ESCAPE$ THEN _
  2106.         GOTO 4765
  2107. 4740 IF PAGE.COUNT MOD 2 THEN _
  2108.         A$ = PAGING.PRINTER.SUPPORT$ + CHR$(7) : _
  2109.         IF LEN(PAGING.PRINTER.SUPPORT$) = 3 AND PRINTER THEN _
  2110.            LPRINT CHR$(7);
  2111. 4745 GOSUB 12978
  2112.      CALL FINDTIME (TI!)
  2113.      IF TI! < PAGE.TIME.MAX! THEN _
  2114.         GOTO 4730
  2115.      GOSUB 12979
  2116. 4750 CALL QTPUT(SYSOP.FIRST.NAME$ + " not responding",1)
  2117. 4755 CALL QTPUT ("Try a message or comment",1)
  2118.      CALL UPDTCALR ("Operator paged " + LEFT$(TIME$,5),2)
  2119.      RETURN
  2120. 4765 CALL UPDTCALR ("Paged & chatted with Sysop",1)
  2121.      CALL QTPUT ("SYSOP in!  " + _
  2122.           FIRST.NAME$ + _
  2123.           ", this is " + _
  2124.           SYSOP.FIRST.NAME$ + _
  2125.           " go ahead!",1)
  2126. 4770 CM = TRUE
  2127.      CALL FINDTIME (TIME.CHAT.STARTED!)
  2128.      SUBROUTINE.PARAMETER = 1
  2129.      CALL LINE25
  2130.      A$(2) = ""
  2131. 4775 CALL LINEEDIT (1,72)
  2132.      IF FUNCTION.KEY <> 0 THEN _
  2133.        GOSUB 60010 : _
  2134.        A$(2) = A$(1) _
  2135.      ELSE IF KEY.PRESSED$ = ESCAPE$ OR SUBROUTINE.PARAMETER = -1 THEN _
  2136.         GOTO 4777
  2137.      A$(1) = ""
  2138.      IF A$(2) <> "" THEN_
  2139.        A$ = A$(2) : _
  2140.        A$(1) = A$(2) : _
  2141.        A$(2) = "" _
  2142.      ELSE _
  2143.        A$ = ""
  2144.      GOSUB 12978
  2145.      GOTO 4775
  2146. 4777 CM = 0
  2147.      CALL FINDTIME (TI!)
  2148.      ELAPSED! = FIX(TI! - TIME.CHAT.STARTED!)
  2149.      IF ELASPED! < 0 THEN _
  2150.         ELASPED! = TI! + (86400! - TIME.CHAT.STARTED!)
  2151.      SECONDS.PER.SESSION! = SECONDS.PER.SESSION! + ELAPSED!
  2152.      IF NOT LOCAL.USER THEN _
  2153.         AUTO.LOGOFF! = TI! + WAIT.BEFORE.DISCONNECT
  2154.      CALL QTPUT("Chat ended.  Returning to normal operation",2)
  2155.      RETURN 1205
  2156. '
  2157. ' *****************************************************************************
  2158. ' *  S - COMMAND FROM UTILITY MENU (STATISTICS)                               *
  2159. ' *****************************************************************************
  2160. '
  2161. 4850 A$ = "RBBS-PC " + VERSION.ID$ + " Node " + NODE.ID$
  2162.      GOSUB 12975
  2163.      IF NOT CONFERENCE.MODE THEN _
  2164.         A$ = "Caller # " + STR$(CALLS.TODATE!) + "  "
  2165. 4855 A$ = A$ + "# active msgs:" + STR$(ACTIVE.MESSAGES)
  2166.      A$ = A$ + "  Next msg #" + STR$(HIGH.MESSAGE.NUMBER + 1)
  2167.      LAST.MESSAGE.READ = -LAST.MESSAGE.READ * _
  2168.                          (LAST.MESSAGE.READ <= HIGH.MESSAGE.NUMBER)
  2169.      IF LAST.MESSAGE.READ > 0 THEN _
  2170.         A$ = A$ + "  Last msg read:" + STR$(LAST.MESSAGE.READ)
  2171. 4857 GOSUB 12976
  2172.      IF SYSOP THEN _
  2173.         USER.WORK = (HIGHEST.USER.RECORD * .95) + 1: _
  2174.         A$ = "USERS: used" + _
  2175.         STR$(CURRENT.USER.COUNT-1) + _
  2176.         " avl" + _
  2177.         STR$(USER.WORK - CURRENT.USER.COUNT) + _
  2178.         "  MSGS: used" + _
  2179.         STR$(ACTIVE.MESSAGES) + _
  2180.         " avl" + _
  2181.         STR$(MAXIMUM.MESSAGES-ACTIVE.MESSAGES) + _
  2182.         "  MSG REC: used" + _
  2183.         STR$(NEXT.MESSAGE.RECORD-1) + _
  2184.         " avl" + _
  2185.         STR$(HIGHEST.MESSAGE.RECORD + 1 + NODES.IN.SYSTEM - NEXT.MESSAGE.RECORD) : _
  2186.         GOSUB 12976
  2187. 4860 GOSUB 12979
  2188.      RETURN
  2189. 4900 CONFERENCE.MODE = TRUE
  2190.      IF NOT LOCAL.USER THEN _
  2191.         CALL UPDTCALR ("Entered " + GRN$,1)
  2192.      CALL QTPUT("Welcome to " + GRN$,1)
  2193. 4905 CALL FINDIT (FILE.NAME$)
  2194.      IF OK THEN _
  2195.         GOSUB 43030 : _
  2196.         GOSUB 6000
  2197. 4910 GOSUB 12986
  2198.      CALL OPENMSG
  2199.      IF EC = 64 THEN _
  2200.         EC = 0 : _
  2201.         GOTO 5360
  2202.      FIELD 1, 128 AS MESSAGE.RECORD$
  2203.      IF LOF(1) = 0 THEN _
  2204.         DF$ = ACTIVE.MESSAGE.FILE$ : _
  2205.         CLOSE 1 : _
  2206.         KILL ACTIVE.MESSAGE.FILE$ : _
  2207.         GOSUB 12987 : _
  2208.         GOTO 13600
  2209.      GOSUB 23000
  2210.      RETURN
  2211. '
  2212. ' *****************************************************************************
  2213. ' *  REMOVE NON ALPHA CHARACTERS FROM STRING                                  *
  2214. ' *****************************************************************************
  2215. '
  2216. 5100 X$ = ""
  2217.      FOR Z = 1 TO LEN(Z$)
  2218.        IF ASC(MID$(Z$,Z,1)) < 32 OR ASC(MID$(Z$,Z,1)) > 90 THEN _
  2219.           GOTO 5105
  2220.        X$ = X$ + MID$(Z$,Z,1)
  2221. 5105 NEXT
  2222.      Z$ = X$
  2223.      RETURN
  2224. '
  2225. ' *****************************************************************************
  2226. ' *  P - COMMAND FROM UTILITY MENU (PASSWORD CHANGE)                          *
  2227. ' *****************************************************************************
  2228. '
  2229. 5110 A$ = "Enter new password" + PRESS.ENTER$
  2230.      GOSUB 45010
  2231.      IF Q = 0 THEN _
  2232.         RETURN
  2233.      IF LEN(B$(1)) > 15 OR B$(1) = SPACE$(LEN(B$(1))) THEN _
  2234.         GOTO 5110
  2235.      CALL ALLCAPSD (B$(),1)
  2236.      Z$ = B$(1)
  2237. 5120 A$ = "Reenter new password"
  2238.      GOSUB 45010
  2239.      IF Q = 0 THEN _
  2240.         RETURN
  2241.      CALL ALLCAPSD (B$(),1)
  2242.      IF Z$ <> B$(1) THEN _
  2243.         A$ = "Passwords don't match!" : _
  2244.         GOSUB 12979 : _
  2245.         RETURN
  2246. 5125 IF MAXIMUM.PASSWORD.CHANGES AND _
  2247.         CHANGES.THIS.SESSION > _
  2248.         MAXIMUM.PASSWORD.CHANGES AND _
  2249.         NOT SYSOP THEN _
  2250.             A$ = "No changes permitted" : _
  2251.             GOSUB 12975 : _
  2252.             RETURN _
  2253.      ELSE PASSWORD.CHANGE.ALLOWED = TRUE : _
  2254.           GOSUB 5140 : _
  2255.           IF NOT FOUND THEN _
  2256.              GOTO 5129 _
  2257.           ELSE A$ = "Temporary change" : _
  2258.                GOSUB 12975 : _
  2259.                PASSWORD$ = TEMP.PASSWORD$ : _
  2260.                SECONDS.PER.SESSION! = TEMP.TIME.ALLOWED * 60 : _
  2261.                USER.SECURITY.LEVEL = TEMP.SECURITY.LEVEL : _
  2262.                GOSUB 41070 : _
  2263.                SYSOP = (USER.SECURITY.LEVEL >= SYSOP.SECURITY.LEVEL) : _
  2264.                CALL CALLOPT
  2265.      IF ACTIVE.USER.NAME$ = "SYSOP" THEN _
  2266.         B$(1) = "********"
  2267. 5126 CALL UPDTCALR ("Used temp password " + B$(1),2)
  2268.      RETURN
  2269. 5129 GOSUB 12989
  2270.      CALL OPENUSER
  2271.      GOSUB 9450
  2272. 5130 GET 5,USER.FILE.INDEX
  2273.      CALL ALLCAPSD (B$(),1)
  2274.      LSET PASSWORD$ = B$(1)
  2275.      PUT 5,USER.FILE.INDEX                                           ' CPC15-1B
  2276.      GOSUB 12991                                                     ' CPC15-1B
  2277.      A$ = "Password changed"
  2278.      STOP.INTERRUPTS = FALSE
  2279.      GOSUB 12975
  2280.      IF MAXIMUM.PASSWORD.CHANGES THEN _
  2281.         CHANGES.THIS.SESSION = CHANGES.THIS.SESSION + 1
  2282. 5131 CALL UPDTCALR ("New Password " + B$(1),2)
  2283.      RETURN
  2284. '
  2285. ' *****************************************************************************
  2286. ' *  SEARCH "PASSWORDS" FILE FOR TEMPORARY PASSWORDS                          *
  2287. ' *****************************************************************************
  2288. '
  2289. 5135 IF USER.SECURITY.LEVEL = DEFAULT.SECURITY.LEVEL THEN _
  2290.         RETURN
  2291.      Z$ = ""
  2292.      Z = 0
  2293.      GOSUB 5140
  2294.      IF FOUND THEN _
  2295.         MINUTES.PER.SESSION! = TEMP.TIME.ALLOWED : _
  2296.         IF TEMP.REG.PERIOD > 0 THEN _
  2297.            DAYS.IN.SUBSCRIPTION.PERIOD = TEMP.REG.PERIOD
  2298.      SECONDS.PER.SESSION! = MINUTES.PER.SESSION! * 60                ' CPC15-1B
  2299.      RETURN
  2300. 5140 FOUND = FALSE
  2301.      CALL OPENWORK (PASSWORDS.FILE$)
  2302.      IF EC = 53 THEN _
  2303.          CALL UPDTCALR ("Missing file " + PASSWORDS.FILE$,2) : _
  2304.          IF Z = 1 THEN _
  2305.             CALL ALLCAPSD (B$(),1) : _
  2306.             Z$ = B$(1) : _
  2307.             GOTO 5160 _
  2308.          ELSE GOTO 5160
  2309.      Z$ = Z$ + SPACE$(15-LEN(Z$))
  2310. 5150 IF EOF(2) THEN _
  2311.         GOTO 5160
  2312. 5151 INPUT #2,TEMP.PASSWORD$,TEMP.SECURITY.LEVEL, _
  2313.               TEMP.TIME.ALLOWED,TEMP.REG.PERIOD
  2314.      IF LEN(TEMP.PASSWORD$) > 15 THEN _
  2315.         GOTO 5150
  2316.      TEMP.PASSWORD$ = TEMP.PASSWORD$ + SPACE$(15-LEN(TEMP.PASSWORD$))
  2317.      IF Z$ <> TEMP.PASSWORD$ THEN _
  2318.         GOTO 5150
  2319.      IF PASSWORD.CHANGE.ALLOWED AND _
  2320.         USER.SECURITY.LEVEL >= MINIMUM.SECURITY.FOR.TEMP.PASSWORD THEN _
  2321.         FOUND = TRUE _
  2322.      ELSE IF USER.SECURITY.LEVEL = TEMP.SECURITY.LEVEL THEN _
  2323.              FOUND = TRUE _
  2324.           ELSE GOTO 5150
  2325. 5160 RETURN
  2326. ' *****************************************************************************
  2327. ' *  COMPUTE THE NUMBER OF DAYS REMAINING UNTIL SUBSCRIPTION EXPIRES          *
  2328. ' *****************************************************************************
  2329. '
  2330. 5170 IF RESTRICT.BY.DATE THEN _
  2331.         CALL COMPDATE (USER.REG.YY,USER.REG.MM,USER.REG.DD,USER.COMPUTE.DATE!): _
  2332.         REG.DAYS.REMAINING = USER.COMPUTE.DATE! + _
  2333.                              DAYS.IN.SUBSCRIPTION.PERIOD - _
  2334.                              TODAY.COMPUTE.DATE! _
  2335.      ELSE REG.DAYS.REMAINING = 365
  2336.      RETURN
  2337. 5200 A$ = "CHANGE page length from" + _
  2338.           STR$(PAGE.LENGTH) + _
  2339.           " TO (0-255, 0=continuous)"
  2340.      GOSUB 12995
  2341.      IF Q = 0 THEN _
  2342.         CALL QTPUT ("No change",1):_
  2343.         RETURN
  2344. 5230 A = VAL(B$(Q))
  2345.      IF A < 0 OR A > 255 THEN _
  2346.         GOTO 5200
  2347.      PAGE.LENGTH = A
  2348.      CALL QTPUT ("Set to"+STR$(PAGE.LENGTH),1)
  2349.      RETURN
  2350. '
  2351. ' *****************************************************************************
  2352. ' *  J - COMMAND FROM MAIN MENU (JOIN CONFERENCE)                             *
  2353. ' *****************************************************************************
  2354. '
  2355. 5300 CALL FINDIT (CONFERENCE.MENU$)
  2356.      IF NOT OK THEN _
  2357.         A$ = "There are no Active Conferences available!" : _
  2358.         GOSUB 12976 : _
  2359.         GOTO 2210
  2360. 5310 IF Q > 1 THEN _
  2361.         B$(1) = B$(2) : _
  2362.         Q = 0 : _
  2363.         IF LEN(B$(2)) > 1 OR _
  2364.           (LEN(B$(2)) = 1 AND NOT INSTR("JLMQX",B$(2))) THEN _
  2365.            GOTO 5322 _
  2366.         ELSE GOTO 5317
  2367. 5312 IF EXPERT.USER THEN _
  2368.         GOTO 5315
  2369. 5313 FILE.NAME$ = CONFERENCE.MENU$
  2370.      GOSUB 43025
  2371. 5315 A$ = "Conference Function <J>oin,<L>ist,<M>ain,<Q>uit,<X>pert"
  2372.      GOSUB 12995
  2373.      IF Q = 0 THEN _
  2374.         GOSUB 12979 : _
  2375.         RETURN _
  2376.      ELSE Z$ = B$(1)
  2377. 5317 CALL ALLCAPSD (B$(),1)
  2378.      IF B$(1) = "X" THEN _
  2379.         GOSUB 4240 : _
  2380.         GOTO 5312
  2381.      FF = INSTR("JLMQ",B$(1))
  2382.      IF FF = 0 THEN _
  2383.         GOTO 5312
  2384.      ON FF GOTO 5320,5313,5350,2210
  2385. 5320 IF Q > 1 THEN _
  2386.         B$(1) = B$(2) : _
  2387.         GOTO 5322
  2388.      A$ = "Enter conference name"
  2389.      GOSUB 12995
  2390.      IF Q = 0 THEN _
  2391.         GOTO 5312
  2392. 5322 IF SYSOP OR LOCAL.USER THEN _
  2393.         GOSUB 5700
  2394. 5323 CALL ALLCAPSD (B$(),1)
  2395.      IF LEN(B$(1)) = 1 AND B$(1) = "M" THEN _
  2396.         GOTO 5350
  2397.      GRN$ = B$(1)
  2398.      GRN.SAVE$ = GRN$                                                ' CPC15-1B
  2399.      Q = 0
  2400.      IF LEN(GRN$) > 7 THEN _
  2401.         EXPERT.USER = FALSE : _
  2402.         GOTO 5312
  2403.      Q = 0
  2404.      IF INSTR(GRN$,".") THEN _
  2405.         GOTO 5312
  2406.      CALL BADFILE (GRN$,BAD.FILE.NAME.INDEX)
  2407.      ON BAD.FILE.NAME.INDEX GOTO 5324,5350,5370
  2408. 5324 FILE.NAME$ = MID$(MAIN.MESSAGE.FILE$,1,2) + GRN$ + "M.DEF"
  2409.      CALL FINDIT (FILE.NAME$)
  2410.      IF NOT OK THEN _
  2411.         GRN$ = GRN.SAVE$ : _                                         ' CPC15-1B
  2412.     GOTO 5312
  2413. '
  2414. ' *****************************************************************************
  2415. ' * WHEN A CONFERENCE FILE IS FOUND, UPDATE THE PREVIOUS MESSAGE FILE CHECK-  *
  2416. ' * POINT RECORD                                                              *
  2417. ' *****************************************************************************
  2418. '
  2419.      GOSUB 12986
  2420.      CALL OPENMSG
  2421.      IF EC = 64 THEN _
  2422.         EC = 0 : _
  2423.         GOTO 5360
  2424.      FIELD 1, 128 AS MESSAGE.RECORD$
  2425.      GET 1,1
  2426.      MID$(MESSAGE.RECORD$,57,5) = STR$(CURRENT.USER.COUNT)
  2427.      MID$(MESSAGE.RECORD$,62,5) = STR$(HIGHEST.USER.RECORD)
  2428.      PUT 1,1
  2429.      GOSUB 12987
  2430.      ACTIVE.MESSAGE.FILE$ = FILE.NAME$
  2431.      GOSUB 5343
  2432.      FILE.NAME$ = MID$(WELCOME.FILE$,1,2) + GRN$ + "W.DEF"
  2433. 5325 IF ACTIVE.USER.NAME$ = "SYSOP" OR _
  2434.         (CONFERENCE.MODE AND (ACTIVE.USER.FILE$ = MAIN.USER.FILE$)) THEN _
  2435.            GOTO 5327
  2436.      GOSUB 12988                                                     ' CPC15-1B
  2437.      CALL OPENUSER                                                   ' CPC15-1B
  2438.      GOSUB 9450                                                      ' CPC15-1B
  2439.      GET 5,MAIN.USER.FILE.INDEX                                      ' CPC15-1B
  2440.      CALL DEFAULTU                                                   ' CPC15-1B
  2441.      PUT 5,MAIN.USER.FILE.INDEX                                      ' CPC15-1B
  2442.      GOSUB 12990                                                     ' CPC15-1B
  2443. 5327 ACTIVE.USER.FILE$ = MID$(ACTIVE.USER.FILE$,1,2) + GRN$ + "U.DEF"
  2444.      UPDATE.DATE = TRUE
  2445.      CALL FINDIT (ACTIVE.USER.FILE$)
  2446.      IF OK THEN _
  2447.         GOTO 5330
  2448.       ACTIVE.USER.FILE$ = MAIN.USER.FILE$
  2449.       UPDATE.DATE = FALSE
  2450.       IF ACTIVE.USER.NAME$ <> "SYSOP" THEN _
  2451.          TIX = MAIN.USER.FILE.INDEX : _
  2452.          USER.FILE.INDEX = MAIN.USER.FILE.INDEX : _                  ' CPC15-1B
  2453.          GOSUB 5382
  2454.       GOTO 5345
  2455. 5330 IF ACTIVE.USER.NAME$ = "SYSOP" THEN _
  2456.         GOTO 5345
  2457.      GOSUB 12598
  2458.      GOSUB 12984
  2459. 5340 IF FOUND THEN _
  2460.         USER.FILE.INDEX = LOC(5) : _
  2461.         TIX = USER.FILE.INDEX : _
  2462.         GOSUB 9500 : _
  2463.         GOTO 5345
  2464.      A$ = "You are not in conference " + GRN$
  2465.      GOSUB 1397
  2466.      GRN$ = "MAIN"
  2467.      USER.FILE.INDEX = MAIN.USER.FILE.INDEX
  2468.      ACTIVE.USER.FILE$ = MAIN.USER.FILE$
  2469.      GOSUB 5382
  2470.      ACTIVE.MESSAGE.FILE$ = MAIN.MESSAGE.FILE$
  2471.      GOSUB 5343
  2472.      CONFERENCE.MODE = FALSE
  2473.      GOSUB 12979
  2474.      RETURN
  2475. '
  2476. ' *****************************************************************************
  2477. ' * WHEN A CONFERENCE FILE IS FOUND, UPDATE THE APPROPRIATE POINTERS FROM THE *
  2478. ' * NEW CONFERENCE                                                            *
  2479. ' *****************************************************************************
  2480. '
  2481. 5343 GOSUB 12986
  2482.      CALL OPENMSG
  2483.      IF EC = 64 THEN _
  2484.         EC = 0 : _
  2485.         GOTO 5360
  2486.      FIELD 1, 128 AS MESSAGE.RECORD$
  2487.      GOSUB 23000
  2488.      RETURN
  2489. 5345 GRN$ = GRN$ + " Conference"
  2490.      IF UPDATE.DATE AND ACTIVE.USER.NAME$ <> "SYSOP" THEN _
  2491.         LSET LAST.DATE.TIME.ON$ = CURRENT.DATE$ + _
  2492.                                   " " + _
  2493.                                   TIME.LOGGED.ON$ : _
  2494.         PUT 5,USER.FILE.INDEX : _
  2495.         GOSUB 12991
  2496. 5347 GOSUB 4900
  2497. 5348 GOSUB 12987
  2498.      RETURN 900
  2499. 5350 GRN$ = "MAIN"
  2500.      Q = 0
  2501.      IF ACTIVE.USER.NAME$ = "SYSOP" THEN _
  2502.         GOSUB 5700 : _
  2503.         ACTIVE.MESSAGE.FILE$ = MAIN.MESSAGE.FILE$ : _
  2504.         ACTIVE.USER.FILE$ = MAIN.USER.FILE$ : _
  2505.         CONFERENCE.MODE = FALSE : _
  2506.         GOSUB 12979 : _
  2507.         CALL OPENUSER : _
  2508.         GOSUB 9450 : _
  2509.         GOSUB 1900 : _
  2510.         RETURN 1200
  2511.      IF NOT LOCAL.USER THEN _
  2512.         CALL UPDTCALR ("Exited Conference",1)
  2513. 5360 IF CONFERENCE.MODE THEN _
  2514.         GOSUB 5380 : _
  2515.         ACTIVE.USER.FILE$ = MAIN.USER.FILE$ : _
  2516.         CONFERENCE.MODE = FALSE : _
  2517.         CALL OPENUSER : _
  2518.         GOSUB 9450 : _
  2519.         USER.FILE.INDEX = MAIN.USER.FILE.INDEX : _
  2520.         GET 5,USER.FILE.INDEX : _
  2521.         GOSUB 9500 : _
  2522.         GOSUB 1900
  2523.      GOSUB 12979
  2524.      IF COMMENTS.IN.CONFERENCE = 1 THEN _
  2525.         COMMENTS.IN.CONFERENCE = 0 : _
  2526.         RETURN
  2527.      RETURN 1200
  2528. 5370 GOSUB 1380
  2529.      GOTO 5312
  2530. '
  2531. ' *****************************************************************************
  2532. ' *    Update Users Record Whenever Leaves a Conference                       *
  2533. ' *****************************************************************************
  2534. 5380 IF TIX > 0 THEN _
  2535.         GOSUB 12989 : _
  2536.         CALL DEFAULTU : _
  2537.         PUT 5,TIX : _
  2538.         GOSUB 12991
  2539.      ACTIVE.MESSAGE.FILE$ = MAIN.MESSAGE.FILE$
  2540.      IF ACTIVE.USER.FILE$ = MAIN.USER.FILE$ THEN _
  2541.         RETURN
  2542.      ACTIVE.USER.FILE$ = MAIN.USER.FILE$
  2543.      USER.FILE.INDEX = MAIN.USER.FILE.INDEX
  2544. 5382 IF USER.FILE.INDEX < 1 THEN _
  2545.         USER.SECURITY.LEVEL = DEFAULT.SECURITY.LEVEL : _
  2546.         RETURN
  2547.      CALL OPENUSER
  2548.      GOSUB 9450
  2549.      GET 5,USER.FILE.INDEX
  2550.      GOSUB 9500
  2551.      RETURN
  2552. '
  2553. ' *****************************************************************************
  2554. ' *  R - COMMAND FROM UTILITY MENU (REVIEW PROFILE)                           *
  2555. ' *****************************************************************************
  2556. '
  2557. 5400 CALL SKIPLINE(2)
  2558.      CALL QTPUT ("Your PROFILE (utilities reset)",1)
  2559. 5410 EXPERT.USER = NOT EXPERT.USER
  2560.      GOSUB 4240
  2561.      GOSUB 43020
  2562.      FF = INSTR("AXCKYIGW",USER.TRANSFER.DEFAULT$)
  2563.      FF = FF-9*(FF < 1)
  2564.      GOSUB 42810
  2565.      UPPER.CASE = NOT UPPER.CASE
  2566.      GOSUB 42960
  2567.      LINE.FEEDS = NOT LINE.FEEDS
  2568.      GOSUB 4100
  2569.      GOSUB 42720
  2570.      PROMPT.BELL = NOT PROMPT.BELL
  2571.      GOSUB 4200
  2572.      CHECK.BULLETIN.LOGON = NOT CHECK.BULLETIN.LOGON
  2573.      GOSUB 4120
  2574.      SKIP.FILES.LOGON = NOT SKIP.FILES.LOGON
  2575.      GOSUB 4140
  2576.      GOSUB 1560                                                      ' CPC15-1B
  2577.      RETURN
  2578. '
  2579. ' *****************************************************************************
  2580. ' *  B - COMMAND FROM UTILITY MENU (300 TO 450 BAUD CHANGE)                   *
  2581. ' *****************************************************************************
  2582. '
  2583. 5500 CALL BAUD450
  2584.      IF LOCAL.USER OR NOT (SUBROUTINE.PARAMETER OR C=20) THEN_
  2585.         RETURN
  2586. 5502 RETURN 10595  'Entry point when have double nested gosub
  2587. '
  2588. ' *****************************************************************************
  2589. ' *  PROVIDE (Y),N,NS MESSAGES FOR TEXT FILES LONGER THAN PAGE LENGTH         *
  2590. ' *****************************************************************************
  2591. '
  2592. 5600 GOSUB 41000
  2593.      CALL FINDTIME(AUTO.LOGOFF!)
  2594.      AUTO.LOGOFF! = AUTO.LOGOFF! + WAIT.BEFORE.DISCONNECT
  2595.      IF NON.STOP THEN _
  2596.         RETURN
  2597.      IF EXPERT.USER THEN _
  2598.         A$ = "More [Y],N,NS"_
  2599.      ELSE A$ = "MORE: [Y]es, N)o, NS)non-stop"
  2600.      NO.ADVANCE = TRUE
  2601.      GOSUB 12995
  2602.      CALL WIPELINE (33)
  2603.      RETURN
  2604. '
  2605. ' *****************************************************************************
  2606. ' *  SAVE SYSOP LAST MESSAGE READ POINTER                                     *
  2607. ' *****************************************************************************
  2608. '
  2609. 5700 GOSUB 12986
  2610.      CALL OPENMSG
  2611.      IF EC = 64 THEN _
  2612.         EC = 0 : _
  2613.         GOTO 5360
  2614.      FIELD 1, 128 AS MESSAGE.RECORD$
  2615.      GET 1,1
  2616.      MID$(MESSAGE.RECORD$,123,4) = "    "
  2617.      MID$(MESSAGE.RECORD$,123,4) = MID$(STR$(LAST.MESSAGE.READ),2)
  2618.      PUT 1,1
  2619.      GOSUB 12985
  2620.      RETURN
  2621. '
  2622. ' *****************************************************************************
  2623. ' *  V - COMMAND FROM MAIN MENU (VIEW CONFERENCES)                            *
  2624. ' *****************************************************************************
  2625. '
  2626. 5800 CALL QTPUT ("V)iew not implemented",1)
  2627.      RETURN
  2628. '
  2629. ' *****************************************************************************
  2630. ' *  DISPLAY TEXT FILES & SCAN DIRECTORIES                                    *
  2631. ' *****************************************************************************
  2632. '
  2633. 6000 IF STOP.INTERRUPTS THEN _
  2634.         A$ = "* <Ctrl K>/<Ctrl X> aborts <Ctrl S> suspends *" : _
  2635.         GOSUB 12976
  2636. 6020 CK = 0
  2637.      GOTO 7100
  2638. 6080 A$ = "Missing file " + FILE.NAME$ + ". Please tell SYSOP"
  2639.      GOSUB 12979
  2640.      RETURN
  2641. '
  2642. ' *****************************************************************************
  2643. ' *  SCAN DIRECTORIES (PRINT TEXT)                                            *
  2644. ' *****************************************************************************
  2645. '
  2646. 7000 A$ = "Scanning Directory " + _
  2647.           FILE.NAME.HOLD$ + _
  2648.           " for " + _
  2649.           A1$
  2650.      GOSUB 12979
  2651.      PG = TRUE
  2652. 7100 CALL OPENWORK (FILE.NAME$)
  2653.      IF EC = 53 THEN _
  2654.         CALL UPDTCALR ("Missing File " + FILE.NAME$,2) : _
  2655.         GOTO 6080
  2656. 7110 CALL CARRIER
  2657.      IF EOF(2) OR _
  2658.         (SUBROUTINE.PARAMETER AND NOT LOCAL.USER) THEN _
  2659.         GOTO 7260
  2660. 7130 LINE INPUT #2,A$
  2661.      IF CK = 0 THEN _
  2662.         GOTO 7250
  2663. 7157 IF CK > 1 THEN _
  2664.         Z$ = A$ : _
  2665.         CALL ALLCAPS (Z$) : _
  2666.         XXX = (INSTR(Z$,RS$) = 0) : _
  2667.         GOTO 7190
  2668. 7160 A = INSTR(9,MID$(A$,1,32),"/")
  2669.      IF A = 0 THEN _
  2670.         A = INSTR(9,MID$(A$,1,32),"-")
  2671. 7162 IF A < 3 THEN _
  2672.         GOTO 7110
  2673.      IF INSTR("0123456789",MID$(A$,A-1,1)) = 0 THEN _
  2674.         GOTO 7110
  2675.      A = A - 2
  2676.      WK$ = RIGHT$(MID$(A$,A,8),2) + _
  2677.            LEFT$(MID$(A$,A,8),2) + _
  2678.            MID$(MID$(A$,A,8),4,2)
  2679.      IF MID$(WK$,3,1) = " " THEN _
  2680.         MID$(WK$,3,1) = "0"
  2681.      IF MID$(WK$,5,1) = " " THEN _
  2682.         MID$(WK$,5,1) = "0"
  2683. 7189 XXX = (WK$ < RS$)
  2684. 7190 IF XXX THEN _
  2685.         GOTO 7110
  2686.      IF PG THEN _
  2687.         PG = FALSE : _
  2688.         CALL OPENWORK (FILE.NAME$) : _
  2689.         Q = 0 : _
  2690.         GOTO 7110
  2691. 7200 IF PG THEN _
  2692.         GOTO 7110
  2693. 7250 GOSUB 12979
  2694.      GOSUB 57110
  2695.      IF NOT RET THEN _
  2696.         GOTO 7110
  2697. 7260 Q = 0
  2698.      CLOSE 2
  2699.      CALL CARRIER
  2700.      IF SUBROUTINE.PARAMETER = -1 THEN _
  2701.         GOTO 10595
  2702.      RETURN
  2703. '
  2704. ' *****************************************************************************
  2705. ' *  FORMAT MESSAGE HEADER INFORMATION FOR DISPLAY                            *
  2706. ' *****************************************************************************
  2707. '
  2708. 8000 GOSUB 12979
  2709.      IF RET THEN _
  2710.         RETURN
  2711. 8020 IF MID$(MESSAGE.RECORD$,37,5) = "ALL  " THEN _
  2712.         MESSAGE.TO$ = "ALL" : _
  2713.         GOTO 8040
  2714. 8030 MESSAGE.TO$ = MID$(MESSAGE.RECORD$,37,22)
  2715.      MESSAGE.TO$ = LEFT$(MESSAGE.TO$ + SPACE$(2),INSTR(MESSAGE.TO$ +SPACE$(2),SPACE$(2))-1)
  2716. 8040 SUBJECT$ = MID$(MESSAGE.RECORD$,76,25)
  2717.      SUBJECT$ = LEFT$(SUBJECT$ + SPACE$(2),INSTR(SUBJECT$ +SPACE$(2),SPACE$(2))-1)
  2718.      IF PASSWORD.FAILED THEN _
  2719.         SUBJECT$ = SJ$
  2720. 8050 MESSAGE.FROM$ = MID$(MESSAGE.RECORD$,6,31)
  2721.      MESSAGE.FROM$ = LEFT$(MESSAGE.FROM$ + SPACE$(2),INSTR(MESSAGE.FROM$ +SPACE$(2),SPACE$(2))-1)
  2722.      A$ = "Msg # " + _
  2723.           LEFT$(MESSAGE.RECORD$,5) + _
  2724.           " Dated " + _
  2725.           MID$(MESSAGE.RECORD$,68,8) + _
  2726.           " " + _
  2727.           MID$(MESSAGE.RECORD$,59,8)
  2728.      IF NOT RET THEN _
  2729.         CALL QTPUT (A$,1): _
  2730.         CALL QTPUT (" From: " + MESSAGE.FROM$,1) : _
  2731.         CALL QTPUT ("   To: " + MESSAGE.TO$,1) : _
  2732.         A$ = "   Re: " + SUBJECT$
  2733.      IF NOT READ.MESSAGES THEN _
  2734.         GOTO 8080
  2735.      IF ADDRESSED.TO.USER THEN _
  2736.         GOTO 8076
  2737.      IF MESSAGE.TO$ = "ALL"  THEN _
  2738.         GOTO 8080
  2739.      IF NOT SYSOP THEN _
  2740.         GOTO 8080
  2741.      IF INSTR(MESSAGE.TO$,"SYSOP") > 0 OR _
  2742.         INSTR(MESSAGE.TO$,SYSOP.FIRST.NAME$ + " " + SYSOP.LAST.NAME$) > 0 THEN _
  2743.         GOTO 8076
  2744.      GOTO 8080
  2745. 8076 IF MID$(MESSAGE.RECORD$,123,6) = STRING$(6,0) OR _
  2746.         MID$(MESSAGE.RECORD$,123,6) = SPACE$(6) THEN _
  2747.         GOTO 8077
  2748.      YY$= RIGHT$(STR$(ASC(MID$(MESSAGE.RECORD$,126,1))),2)+ ":" + _
  2749.           RIGHT$(STR$(ASC(MID$(MESSAGE.RECORD$,127,1))),2)+ ":" + _
  2750.           RIGHT$(STR$(ASC(MID$(MESSAGE.RECORD$,128,1))),2)
  2751.      FOR I = 1 TO 8
  2752.         IF MID$(YY$,I,1) = " " THEN _
  2753.            MID$(YY$,I,1) = "0"
  2754.      NEXT
  2755.      YY$ = YY$ + " on "
  2756.      YY$ = YY$ + _
  2757.           RIGHT$(STR$(ASC(MID$(MESSAGE.RECORD$,123,1))),2)+ "/" + _
  2758.           RIGHT$(STR$(ASC(MID$(MESSAGE.RECORD$,124,1))),2)+ "/" + _
  2759.           RIGHT$(STR$(ASC(MID$(MESSAGE.RECORD$,125,1))),2)
  2760.      FOR I = 13 TO 20
  2761.         IF MID$(YY$,I,1) = " " THEN _
  2762.            MID$(YY$,I,1) = "0"
  2763.      NEXT
  2764.      A$ = A$ + " Last read at " + YY$
  2765. 8077 YY$ = DATE$
  2766.      WK$ = TIME$
  2767.      MID$(MESSAGE.RECORD$,123,6) = CHR$(VAL(MID$(YY$,1,2))) + _
  2768.                                    CHR$(VAL(MID$(YY$,4,2))) + _
  2769.                                    CHR$(VAL(MID$(YY$,9,2))) + _
  2770.                                    CHR$(VAL(MID$(WK$,1,2))) + _
  2771.                                    CHR$(VAL(MID$(WK$,4,2))) + _
  2772.                                    CHR$(VAL(MID$(WK$,7,2)))
  2773.      GOSUB 12986
  2774.      PUT 1,M(MESSAGE.DIM.INDEX,1)
  2775.      GOSUB 12987
  2776. 8080 GOSUB 12979
  2777.      RETURN
  2778. '
  2779. ' *****************************************************************************
  2780. ' * UNCOMPRESS MESSAGE PRIOR TO DISPLAY                                       *
  2781. ' *****************************************************************************
  2782. '
  2783. 9000 GOSUB 12979
  2784.      FOR X = 2 TO VAL(MID$(MESSAGE.RECORD$,117,4))
  2785.        GOSUB 12978
  2786.        EOL = FALSE
  2787.        J = 1
  2788.        GET 1
  2789. 9050   B = INSTR(J,MESSAGE.RECORD$,CHR$(227))
  2790.        IF RET THEN _
  2791.           RETURN
  2792. 9060   C = B-J
  2793.        IF C < 0 THEN _
  2794.           C = 128 : _
  2795.           EOL = TRUE
  2796. 9070   A$ = MID$(MESSAGE.RECORD$,J,C)
  2797.        IF EOL THEN _
  2798.           GOTO 9090
  2799. 9085   J = B + 1
  2800.        CALL QTPUT (A$,1)
  2801.        GOSUB 57110
  2802.        GOTO 9050
  2803. 9090 NEXT
  2804.      A$ = ""
  2805.      RETURN
  2806. '
  2807. ' *****************************************************************************
  2808. ' *  C - COMMAND FROM UTILITY MENU (CLOCK - TIME ON SYSTEM)                   *
  2809. ' *****************************************************************************
  2810. '
  2811. 9100 GOSUB 12979
  2812.      CALL GETIME
  2813.      SUBROUTINE.PARAMETER = 2
  2814.      CALL AMORPM
  2815.      QX = ((HHH*60) + MMM + (SSS/60.0))*10.0
  2816.      Q! = QX/10.0
  2817.      MINS = (HHH*60) + MMM
  2818.      CALL QTPUT("It is now: " + DATE$ + " at " + TIME$,1)            ' CPC15-1B
  2819.      CALL QTPUT("You have been on-line for" + STR$(MINS) + " minutes," + STR$(SSS) + " seconds",1) ' CPC15-1B
  2820.      RETURN
  2821. '
  2822. ' *****************************************************************************
  2823. ' * DEFINE USER FILE RECORD VARIABLES TO COMPENSATE FOR THE BUG IN QUICKBASIC *
  2824. ' * THAT REQUIRES A FIELD STATMENT TO BE EXECUTED WITHIN EACH SEPERATELY      *
  2825. ' * COMPILED PROGRAM -- EVEN THOUGH A FIELD STATEMENT WAS EXECUTED WHEN THE   *
  2826. ' * FILE WAS OPENED IN ANOTHER SEPERATELY COMPILED SUBROUTINE                 *
  2827. ' *****************************************************************************
  2828. '
  2829. 9450 FIELD 5,31 AS USER.NAME$, _
  2830.              15 AS PASSWORD$, _
  2831.               2 AS SECURITY.LEVEL$, _
  2832.              14 AS USER.OPTIONS$,  _
  2833.              24 AS CITY.STATE$, _
  2834.              19 AS MACHINE.TYPE$, _
  2835.              14 AS LAST.DATE.TIME.ON$, _
  2836.               3 AS LIST.NEW.DATE$, _
  2837.               2 AS USER.DOWNLOADS$, _
  2838.               2 AS USER.UPLOADS$, _
  2839.               2 AS ELAPSED.TIME$
  2840.      FIELD 5,128 AS USER.RECORD$
  2841.      RETURN
  2842. '
  2843. ' *****************************************************************************
  2844. ' * GET USER DEFAULTS                                                         *
  2845. ' *****************************************************************************
  2846. '
  2847. 9500 USER.SECURITY.LEVEL = CVI(SECURITY.LEVEL$)
  2848.      LAST.MESSAGE.READ = CVI(MID$(USER.OPTIONS$,3,2))
  2849.      USER.TRANSFER.DEFAULT$ = MID$(USER.OPTIONS$,5,1)
  2850.      GR = VAL(MID$(USER.OPTIONS$,6,1))
  2851.      IF NOT EIGHT.BIT THEN _
  2852.         GR = 0
  2853.      USER.GRAPHIC.DEFAULT$ = MID$(" GC",GR + 1,-(GR > 0))
  2854.      RIGHT.MARGIN = CVI(MID$(USER.OPTIONS$,7,2))
  2855. 9510 USER.OPTIONS = CVI(MID$(USER.OPTIONS$,9,2))
  2856.      PROMPT.BELL = (USER.OPTIONS AND 1) > 0
  2857.      EXPERT.USER = (USER.OPTIONS AND 2) > 0
  2858.      NULLS = (USER.OPTIONS AND 4) > 0
  2859.      UPPER.CASE = (USER.OPTIONS AND 8) > 0
  2860.      LINE.FEEDS = (USER.OPTIONS AND 16) > 0
  2861.      CHECK.BULLETIN.LOGON = (USER.OPTIONS AND 32) > 0
  2862.      SKIP.FILES.LOGON = (USER.OPTIONS AND 64) > 0
  2863.      AUTODOWNLOAD.DESIRED = (USER.OPTIONS AND 128) > 0               ' CPC15-1B
  2864.      REQ.QUES.ANSWERED = (USER.OPTIONS AND 256) > 0
  2865.      GOSUB 11480
  2866.      PAGE.LENGTH = ASC(MID$(USER.OPTIONS$,13,1))
  2867. 9520 NUL$ = MID$(STRING$(5,0),1,-5*NULLS)
  2868.      CALL SETCRLF
  2869.      PASSWORD.SAVE$ = PASSWORD$
  2870.      RETURN
  2871. '
  2872. ' *****************************************************************************
  2873. ' *  B - COMMAND FROM MAIN MENU (READ BULLETINS)                              *
  2874. ' *****************************************************************************
  2875. '
  2876. 9700 IF ACTIVE.BULLETINS < 1 THEN _
  2877.         A$ = "no bulletins today" : _
  2878.         GOSUB 1397 : _
  2879.         RETURN
  2880.      IF Q > 1 THEN _
  2881.         ANS.INDEX = 2: _
  2882.         LAST.INDEX = Q: _
  2883.         GOTO 9708
  2884. 9705 FILE.NAME$ = BULLETIN.MENU$
  2885.      GOSUB 1790
  2886. 9707 GOSUB 41000
  2887.      NON.STOP = FALSE
  2888.      ANS.INDEX = 1
  2889.      A$ = "Bulletin #(s) [1 thru" + STR$(ACTIVE.BULLETINS) + _
  2890.           "], L)ist, N)ew"
  2891.      CALL SKIPLINE (1)
  2892.      GOSUB 12998
  2893.      IF Q = 0 THEN _
  2894.         RETURN
  2895.      ANS.INDEX = 1
  2896.      LAST.INDEX = Q
  2897. 9708 CALL CARRIER
  2898.      IF SUBROUTINE.PARAMETER = -1 THEN _
  2899.         RETURN 10595
  2900.      CALL ALLCAPSD (B$(),ANS.INDEX)
  2901.      ON INSTR("LN",B$(ANS.INDEX)) GOTO 9705,9760
  2902. 9711 Z$ = MID$(STR$(VAL(B$(ANS.INDEX))),2)
  2903.      IF VAL(Z$) > 0 AND VAL(Z$) <= ACTIVE.BULLETINS THEN _
  2904.         GOTO 9720
  2905.      GOTO 9725
  2906. 9720 IF NOT LOCAL.USER THEN _
  2907.         CALL UPDTCALR ("Read Bulletin " + Z$,1)
  2908.      FILE.NAME$ = BULLETIN.PREFIX$ + Z$
  2909.      CALL FINDIT (FILE.NAME$)
  2910.      IF NOT OK THEN _
  2911.         GOTO 9707
  2912.      STOP.INTERRUPTS = TRUE
  2913.      GOSUB 1790
  2914.      STOP.INTERRUPTS = FALSE
  2915.      CALL DISPLAYTR (TIME.REMAINING!)
  2916. 9725 ANS.INDEX = ANS.INDEX + 1
  2917.      IF ANS.INDEX <= LAST.INDEX THEN _
  2918.         GOTO 9708
  2919.      GOTO 9707
  2920. ' *****************************************************************************
  2921. ' *  CHECK AND REVIEW NEW BULLETINS SINCE LAST LOGON                          *
  2922. ' *****************************************************************************
  2923. 9750 CALL CHKNEWBUL (PREV.LAST.ON$,NUM.NEW.BULLETS,NEW.BULLETS$)
  2924.      CALL SKIPLINE (1)
  2925.      A$ = STR$(NUM.NEW.BULLETS) + " NEW BULLETIN(S) since last call" + _
  2926.              NEW.BULLETS$
  2927.      GOSUB 12979
  2928.      RETURN
  2929. 9760 ' ****  [entry when want review plus chance to read] *********
  2930.      GOSUB 9750
  2931.      IF NUM.NEW.BULLETS > 0 THEN _
  2932.         LAST.INDEX = Q : _
  2933.         A$ = "READ new bulletins (Y=[ENTER],N)" : _
  2934.         GOSUB 12995 : _
  2935.         IF NOT NO THEN _
  2936.            ANS.INDEX = 2: _
  2937.            GOTO 9708
  2938.      IF ANS.INDEX < 1 THEN _
  2939.         RETURN _
  2940.      ELSE _
  2941.         GOTO 9707
  2942. '
  2943. ' *****************************************************************************
  2944. ' *  W - COMMAND FROM MAIN MENU (WHO'S ON THE OTHER NODES)                    *
  2945. ' *****************************************************************************
  2946. '
  2947. 9800 IF CONFERENCE.MODE THEN _
  2948.         A$ = "Nodes won't display within a conference!" : _
  2949.         GOSUB 12977 : _
  2950.         RETURN
  2951.      GOSUB 12979
  2952.      CALL OPENMSG
  2953.      IF EC = 64 THEN _
  2954.         EC = 0 : _
  2955.         GOTO 5360
  2956.      FIELD 1, 128 AS MESSAGE.RECORD$
  2957.      FOR NODE.INDEX = 2 TO NODES.IN.SYSTEM + 1
  2958.         GET 1,NODE.INDEX
  2959.         A$ = "Node" + _                                              ' CPC15-1B
  2960.              STR$(NODE.INDEX - 1)                                    ' CPC15-1B
  2961.         IF MID$(MESSAGE.RECORD$,57,1) = "A" THEN _                   ' CPC15-1B
  2962.            A$ = A$ + "  Online at " + _                              ' CPC15-1B
  2963.                 MID$(MESSAGE.RECORD$,60,4) + _                       ' CPC15-1B
  2964.                 " bps: " + _                                         ' CPC15-1B
  2965.                 MID$(MESSAGE.RECORD$,1,26) + _                       ' CPC15-1B
  2966.                 MID$(MESSAGE.RECORD$,93,24) _                        ' CPC15-1B
  2967.         ELSE IF NOT SYSOP THEN _                                     ' CPC15-1B
  2968.                 A$ = A$ + " Waiting for next caller" _               ' CPC15-1B
  2969.              ELSE _                                                  ' CPC15-1B
  2970.                 A$ = A$ + " Offline at " + _                         ' CPC15-1B
  2971.                      MID$(MESSAGE.RECORD$,60,4) + _                  ' CPC15-1B
  2972.                      " bps: " + _                                    ' CPC15-1B
  2973.                      MID$(MESSAGE.RECORD$,1,26) + _                  ' CPC15-1B
  2974.                      MID$(MESSAGE.RECORD$,93,24)                     ' CPC15-1B
  2975.         GOSUB 12979
  2976.      NEXT
  2977.      RETURN
  2978. '
  2979. ' *****************************************************************************
  2980. ' *  1 - COMMAND FROM SYSOP MENU (DISPLAY COMMENTS)                           *
  2981. ' *****************************************************************************
  2982. '
  2983. 10070 CALL MUSIC (7)
  2984.       FILE.NAME$ = COMMENTS.FILE$
  2985.       GOSUB 6000
  2986.       RETURN
  2987. '
  2988. ' *****************************************************************************
  2989. ' *  U - COMMAND FROM UTILITY MENU (DISPLAY USERS)                            *
  2990. ' *  2 - COMMAND FROM SYSOP MENU (DISPLAY USERS)                              *
  2991. ' *****************************************************************************
  2992. '
  2993. 10090 CALL MUSIC (6)
  2994.       A$ = "List - U)sers, R)ecent callers"
  2995.       CALL SKIPLINE (1)
  2996.       GOSUB 12998
  2997.       IF Q = 0 THEN _
  2998.          RETURN
  2999.       CALL ALLCAPSD (B$(),1)
  3000.       ON INSTR("UR",B$(1)) + 1 GOTO 10090,10096,57000
  3001. 10096 GOSUB 12700
  3002.       CALL OPENUSER
  3003.       GOSUB 9450
  3004.       STOP.INTERRUPTS = TRUE
  3005.       NON.STOP = (PAGE.LENGTH < 1)
  3006.       I = 1
  3007. 10097 IF I > HIGHEST.USER.RECORD THEN GOTO 10099
  3008.         GET 5,I
  3009.         X$ = MID$(USER.RECORD$,START.HASH,LEN.HASH)
  3010.         IF ASC(X$)=0 OR LEFT$(X$,3)="   " OR LEFT$(PASSWORD$,3)="   " THEN _
  3011.            GOTO 10098
  3012.         GOSUB 57110
  3013.         CALL QTPUT (LEFT$(X$,36)+CITY.STATE$+LAST.DATE.TIME.ON$,1)
  3014. 10098 I = I + 1
  3015.       GOTO 10097
  3016. 10099 A$ = ""
  3017.       STOP.INTERRUPTS = FALSE
  3018.       RETURN
  3019. '
  3020. ' *****************************************************************************
  3021. ' *  3 - COMMAND FROM SYSOP MENU (RECOVER MESSAGES)                           *
  3022. ' *****************************************************************************
  3023. '
  3024. 10390 A$ = "Recover Msg #"
  3025.       GOSUB 12995
  3026.       MESSAGE.TO.RECOVER = VAL(B$(1))
  3027.       IF MESSAGE.TO.RECOVER < 1 THEN _
  3028.          GOTO 12980
  3029.       CALL OPENMSG
  3030.       IF EC = 64 THEN _
  3031.          EC = 0 : _
  3032.          GOTO 5360
  3033.       FIELD 1, 128 AS MESSAGE.RECORD$
  3034.       ACTION.FLAG = FALSE
  3035.       CALL RECOVMSG (MESSAGE.TO.RECOVER,FIRST.MESSAGE.RECORD,ACTION.FLAG)
  3036.       IF ACTION.FLAG THEN _
  3037.          A$ = "Re-Loading Msg File" : _
  3038.          GOSUB 12979 : _
  3039.          GOSUB 1900
  3040.       RETURN
  3041.  
  3042. '
  3043. ' *****************************************************************************
  3044. ' *  4 - COMMAND FROM SYSOP MENU (DELETE COMMENTS)                            *
  3045. ' *****************************************************************************
  3046. '
  3047. 10530 A$ = "Delete comments (Y/N)"
  3048.       GOSUB 12995
  3049.       IF YES THEN _
  3050.          CLOSE 2 : _
  3051.          IF SHARE.IT THEN _
  3052.             OPEN COMMENTS.FILE$ FOR OUTPUT SHARED AS #2 _
  3053.          ELSE OPEN "O",2,COMMENTS.FILE$
  3054.       CLOSE 2
  3055. 10550 RETURN 1200
  3056. '
  3057. ' *****************************************************************************
  3058. ' *  TIME LIMIT EXCEEDED EXIT                                                 *
  3059. ' *****************************************************************************
  3060. '
  3061. 10553 A$ = MID$("SessionDaily",-7*LIMIT.DAILY.TIME+1,7) + _
  3062.                 " time limit exceeded"
  3063.       CALL UPDTCALR (A$,1)
  3064.       GOSUB 1397
  3065. '
  3066. ' *****************************************************************************
  3067. ' *  Q - COMMAND FROM GLOBAL FUNCTIONS                                        *
  3068. ' *****************************************************************************
  3069. '
  3070. 10560 CHAT.AVAILABLE = FALSE
  3071.       GOSUB 9100
  3072.       IF NOT SYSOP THEN _
  3073.          QUESTIONNAIRE$ = "EPILOG.DEF" : _
  3074.          GOSUB 11510
  3075.       CALL QTPUT(FIRST.NAME$ + ", Thanks and please call again!",1)
  3076.       IF BPS = -1 THEN _
  3077.          CALL DELAYIT (1)
  3078.       IF LOCAL.USER.MODE OR NOT LOCAL.USER THEN _
  3079.          CALL UPDTCALR ("Logged off",1)
  3080.       CALL MUSIC (4)
  3081.       GOTO 10595
  3082. 10570 IF TIME.REMAINING! > 1 AND NOT EXPERT.USER THEN _
  3083.          A$ = "Disconnect the call (Y,N=[ENTER])":_
  3084.          GOSUB 12995:_
  3085.          IF NOT YES THEN _
  3086.             RETURN
  3087.       GOTO 10560
  3088. 10590 CALL UPDTCALR ("Sleep Disconnect",1)
  3089. 10595 CALL GETIME
  3090.       GOSUB 13700
  3091.       IF (SYSOP OR LOCAL.USER) AND MAIN.USER.FILE.INDEX = 0 THEN _
  3092.          GOSUB 5700
  3093.       IF MAIN.USER.FILE.INDEX < 1 THEN _
  3094.      CLS : _
  3095.          GOTO 13540
  3096.       IF CONFERENCE.MODE THEN _
  3097.          GOSUB 5380
  3098.       SYSOP = FALSE
  3099.       CALL UPDATEU
  3100.       GOTO 13540
  3101. 10620 CALL UPDTCALR(LG$(LOGON.ERROR.INDEX),2)
  3102. 10621 IF ACTIVE.USER.NAME$ = "" THEN _
  3103.          ACTIVE.USER.NAME$ = "NAME UNAVAILABLE"
  3104.       Z$ = ACTIVE.USER.NAME$ + _
  3105.            " on at " + _
  3106.            CURRENT.DATE$ + _
  3107.            ", " + _
  3108.            TIM$ + _
  3109.            "** LOGON DENIED **, " + _
  3110.            BAUD.PARITY$
  3111.       NG$ = Z$ + SPACE$(128-LEN(Z$))
  3112. 10698 CALL MUSIC (5)
  3113.       A$ = "Access denied!"
  3114.       GOSUB 12976
  3115.       IF BPS = -1 THEN _
  3116.          CALL DELAYIT (1)
  3117.       GOTO 13545
  3118. '
  3119. ' *****************************************************************************
  3120. ' *  M - COMMAND FROM UTILITY MENU (CHANGE MARGINS)                           *
  3121. ' *****************************************************************************
  3122. '
  3123. 10925 UTILITY.MARGIN.CHANGE = TRUE
  3124.       GOSUB 3100
  3125.       UTILITY.MARGIN.CHANGE = FALSE
  3126.       RETURN
  3127. '
  3128. ' *****************************************************************************
  3129. ' *  7 - COMMAND FROM SYSOP MENU (EXIT TO DOS)                                *
  3130. ' *****************************************************************************
  3131. '
  3132. 10930 IF DOS.VERSION < 2 OR _                                        ' CPC15-1B
  3133.          (REQUIRED.RINGS = 0 AND NOT SHOOT.YOURSELF) THEN _          ' CPC15-1B
  3134.          A$ = "Remote DOS unavailable" : _
  3135.          RETURN
  3136. 10932 IF LOCAL.USER AND NOT DEBUG THEN _
  3137.          A$ = "Only for remote SYSOP's" : _
  3138.          RETURN
  3139.       CALL DOSEXIT
  3140.       GOTO 31000
  3141. '
  3142. ' *****************************************************************************
  3143. ' *  D - COMMAND FROM MAIN MENU (EXIT TO DOORS)                               *
  3144. ' *****************************************************************************
  3145. '
  3146. 10970 IF NOT DOORS.AVAILABLE OR _                                    ' CPC15-1B
  3147.          (REQUIRED.RINGS = 0 AND NOT SHOOT.YOURSELF) THEN _          ' CPC15-1B
  3148.          A$ = "All doors locked!" : _
  3149.          RETURN
  3150.       IF CONFERENCE.MODE THEN _
  3151.          A$ = "Cannot exit to a Door when in a Conference!" : _
  3152.          RETURN
  3153. 10973 FILE.NAME$ = MENU$(5)
  3154.       GOSUB 43025
  3155.       IF USER.SECURITY.LEVEL < DOORS.SECURITY.LEVEL THEN _           ' CPC15-1B
  3156.          CALL QTPUT ("You do not have a key for my Doors!",2) : _    ' CPC15-1B
  3157.          A$ = "" : _                                                 ' CPC15-1B
  3158.          RETURN                                                      ' CPC15-1B
  3159. 10974 A$ = "Open which door"
  3160.       GOSUB 12998
  3161.       IF Q = 0 THEN _
  3162.          RETURN
  3163.       Z$ = B$(1)
  3164.       CALL WORDINFILE (FILE.NAME$,Z$,FOUND)
  3165.       CALL CARRIER
  3166.       IF SUBROUTINE.PARAMETER = -1 THEN _
  3167.          RETURN 10595
  3168.       IF NOT FOUND THEN _
  3169.          CALL QTPUT ("No such Door "+Z$,1): _
  3170.          GOTO 10973
  3171.       Z$ = Z$ + ".BAT"
  3172. 10986 CALL FINDIT (Z$)
  3173.       IF NOT OK THEN _
  3174.          CALL UPDTCALR ("Door " + Z$ + " missing",2) : _
  3175.          GOTO 10973
  3176.       CALL DOOREXIT
  3177. '
  3178. ' *****************************************************************************
  3179. ' *  5 - COMMAND FROM SYSOP MENU (USER FILE MAINTENANCE)                      *
  3180. ' *****************************************************************************
  3181. '
  3182. 11000 TU = USER.FILE.INDEX
  3183.       STOP.INTERRUPTS = TRUE
  3184.       I = 1
  3185.       SCAN.USERS = FALSE
  3186.       A$ = "A)dd, L)st, P)rt, M)od, S)can users"
  3187.       GOSUB 12998
  3188. 11003 IF Q = 0 THEN _
  3189.          GOTO 20093
  3190.       QQ = 0
  3191.       Z$ = LEFT$(B$(1),1)
  3192.       CALL ALLCAPS (Z$)
  3193.       IF Z$ = "A" THEN _
  3194.          GOTO 12300 _
  3195.       ELSE IF Z$ = "M" THEN _
  3196.               STOP.INTERRUPTS = FALSE _
  3197.            ELSE IF Z$ = "P" THEN _
  3198.                    QQ = TRUE _
  3199.                 ELSE IF Z$ = "S" THEN _
  3200.                         SCAN.USERS = TRUE : _
  3201.                         STOP.INTERRUPTS = FALSE _
  3202.                      ELSE IF Z$ <> "L" THEN _
  3203.                              GOTO 11000
  3204. 11005 CALL OPENUSER
  3205.       GOSUB 9450
  3206.       Z = 1
  3207.       IF SCAN.USERS THEN _
  3208.          A$ = "Scan for N)ame, P)wd, C)ity/St, or L)evel" : _
  3209.          GOSUB 12995 : _
  3210.          SCAN.FUNCTION$ = LEFT$(B$(1),1) : _
  3211.          CALL ALLCAPS (SCAN.FUNCTION$) : _
  3212.          CR = 0 : _
  3213.          GOSUB 12979 : _
  3214.          GOSUB 12966 : _
  3215.       GOTO 12962
  3216. 11010 FOR J = Z TO HIGHEST.USER.RECORD
  3217.         GET 5,J
  3218. 11015   X$ = MID$(USER.RECORD$,START.HASH,LEN.HASH)
  3219.         IF ASC(X$) = 0 OR LEFT$(X$,3) = "   " THEN _
  3220.            GOTO 11310
  3221.         OF = CVI(SECURITY.LEVEL$)
  3222.         A$ = RIGHT$("     "+STR$(LOC(5)),4) + _
  3223.              ":" + _
  3224.              USER.NAME$ + _
  3225.              "SECURITY" + _
  3226.              RIGHT$("     "+STR$(OF),5) + _
  3227.              " "
  3228. 11020   A$ = A$ + _
  3229.              "Password = " + _
  3230.              PASSWORD$
  3231. 11025   IF QQ THEN _
  3232.            CALL PRINTIT (A$)
  3233. 11027   GOSUB 12979
  3234.         IF RET <> 0 THEN _
  3235.            GOTO 11330
  3236.         IF OF < MINIMUM.LOGON.SECURITY THEN _
  3237.            A$ = "     <Locked out>  " : _
  3238.            GOTO 11030
  3239.         IF OF >= SYSOP.SECURITY.LEVEL THEN _
  3240.            A$ = "     (SYSOP)       " : _
  3241.            GOTO 11030
  3242.         A$ = SPACE$(19)
  3243. 11030   A$ = A$ + _
  3244.              LAST.DATE.TIME.ON$ + _
  3245.              "   " + _
  3246.              CITY.STATE$ + _
  3247.              MACHINE.TYPE$
  3248. 11100   IF QQ THEN _
  3249.            CALL PRINTIT (A$)
  3250. 11101   CALL QTPUT(A$,1)
  3251.         IF RET <> 0 THEN _
  3252.            GOTO 11330
  3253.         A$ = "  DOWNLOADS = " + _
  3254.              RIGHT$("     "+STR$(CVI(USER.DOWNLOADS$)),5) + "   " + _
  3255.              "UPLOADS = " + _
  3256.              RIGHT$("     "+STR$(CVI(USER.UPLOADS$)),5) + "   " + _
  3257.              " Times on ="
  3258.          A$ = A$+RIGHT$("     "+STR$(CVI(MID$(USER.OPTIONS$,1,2))),5) + "   " + _
  3259.              "TIME USED = " + _
  3260.              RIGHT$("     "+STR$(CVI(ELAPSED.TIME$)),5) + _
  3261.              " Min"
  3262.         IF QQ THEN _
  3263.            CALL PRINTIT (A$)
  3264. 11105   CALL QTPUT (A$,1)
  3265.         IF RET <> 0 THEN _
  3266.            GOTO 11330
  3267.         IF NOT RESTRICT.BY.DATE THEN _
  3268.            GOTO 11107
  3269.         GOSUB 11480
  3270.         A$ = "Subscription date = " + REG.DISPLAY.DATE$
  3271.         IF QQ THEN _
  3272.            CALL PRINTIT (A$)
  3273.         CALL QTPUT (A$,1)
  3274.         IF RET <> 0 THEN _
  3275.            GOTO 11330
  3276. 11107   IF STOP.INTERRUPTS THEN _
  3277.            GOTO 11310
  3278. 11110   CALL QTPUT ("D)elete,  F)ind,  M)enu,  N)ew pwd,  P)rint,",1)
  3279.         A$ = "R)eset graphics,  Q)uit,  S)ecurity, #)user"
  3280.         IF RESTRICT.BY.DATE THEN _
  3281.            A$ = A$ + ", $)Reg Date"
  3282.         GOSUB 12995
  3283.         IF NOT SCAN.USERS AND Q = 0 THEN _
  3284.            GOTO 11310
  3285. 11115   Z$ = LEFT$(B$(1),1)
  3286.         CALL ALLCAPS (Z$)
  3287.         X = INSTR("DNPQFSMR$",Z$)
  3288.         IF Z$ = "" AND SCAN.USERS THEN _
  3289.            GOTO 12965
  3290.         ON X GOTO 11130,11160,11220,11320,11340,11390,11330,11400,11450
  3291. 11125   Z = VAL(B$)
  3292.         IF Z < 1 OR Z > HIGHEST.USER.RECORD-1 THEN _
  3293.            GOTO 11310
  3294.         GOTO 11010
  3295. '
  3296. ' *****************************************************************************
  3297. ' *  D - COMMAND FROM 5- USER MAINTENANCE OPTIONS (DELETE USER)               *
  3298. ' *****************************************************************************
  3299. '
  3300. 11130   A$ = "Delete user (Y/[N])"                                   ' CPC15-1B
  3301.         GOSUB 12995
  3302.         IF YES THEN _                                                ' CPC15-1B
  3303.            LSET USER.NAME$ = CHR$(0)+"deleted user" : _              ' CPC15-1B
  3304.            LSET SECURITY.LEVEL$ = MKI$(MINIMUM.LOGON.SECURITY -1) : _ ' CPC15-1B
  3305.            LSET LAST.DATE.TIME.ON$ = "01/01/80" + " " + TIME.LOGGED.ON$  ' CPC15-1B
  3306.         GOTO 11290
  3307. '
  3308. ' *****************************************************************************
  3309. ' *  N - COMMAND FROM 5- USER MAINTENANCE OPTIONS (CHANGE USER PASSWORD)      *
  3310. ' *****************************************************************************
  3311. '
  3312. 11160   GOSUB 12800
  3313.         GOTO 11290
  3314. '
  3315. ' *****************************************************************************
  3316. ' *  P - COMMAND FROM 5- USER MAINTENANCE OPTIONS (PRINT USER FILE)           *
  3317. ' *****************************************************************************
  3318. '
  3319. 11220   QQ = NOT QQ
  3320.         GOTO 11015
  3321. 11290   USER.FILE.INDEX = LOC(5)
  3322.         GOSUB 12989
  3323.         PUT 5,USER.FILE.INDEX
  3324.         GOSUB 12991
  3325.         USER.FILE.INDEX = 0
  3326.         GOTO 11015
  3327. 11310   IF SCAN.USERS THEN _
  3328.            GOTO 12965
  3329. 11311 NEXT
  3330. '
  3331. ' *****************************************************************************
  3332. ' *  Q - COMMAND FROM 5- USER MAINTENANCE OPTIONS (QUIT TO MAIN MENU)         *
  3333. ' *****************************************************************************
  3334. '
  3335. 11320 USER.FILE.INDEX = TU                                           ' CPC15-1B
  3336.       RETURN 1200
  3337. '
  3338. ' *****************************************************************************
  3339. ' *  M - COMMAND FROM 5- USER MAINTENANCE OPTIONS (MAIN USER MAINT. MENU)     *
  3340. ' *****************************************************************************
  3341. '
  3342. 11330 CLOSE 2
  3343.       GOTO 11000
  3344. '
  3345. ' *****************************************************************************
  3346. ' *  F - COMMAND FROM 5- USER MAINTENANCE OPTIONS (FIND USER)                 *
  3347. ' *****************************************************************************
  3348. '
  3349. 11340 A$ = PROMPT.HASH$+" to find"
  3350.       CALL SKIPLINE (1)
  3351.       GOSUB 12995
  3352.       IF Q = 0 THEN _
  3353.          GOTO 11340
  3354.       TEMP.HASH.VALUE$ = B$(1)
  3355.       IF LEN(TEMP.HASH.VALUE$) < 3 OR LEN(TEMP.HASH.VALUE$) > LEN.HASH THEN _
  3356.          GOTO 11340
  3357.       CALL ALLCAPS (TEMP.HASH.VALUE$)
  3358.       IF START.INDIV < 1 THEN _
  3359.          GOTO 11345
  3360. 11342 A$ = PROMPT.INDIV$+" to find"
  3361.       GOSUB 12995
  3362.       IF Q = 0 THEN _
  3363.          GOTO 11342
  3364.       TEMP.INDIV.VALUE$ = B$(1)
  3365.       IF LEN(TEMP.INDIV.VALUE$) < 3 OR LEN(TEMP.INDIV.VALUE$) > LEN.INDIV THEN _
  3366.          GOTO 11342
  3367.       CALL ALLCAPS (TEMP.INDIV.VALUE$)
  3368. 11345 GOSUB 12600
  3369.       GOSUB 12984
  3370.       USER.FILE.INDEX = 0
  3371.       IF FOUND THEN _
  3372.          GOTO 11015
  3373. 11380 A$ = TEMP.HASH.VALUE$ + " " + TEMP.INDIV.VALUE$ + " not found"
  3374.       GOSUB 12977
  3375.       GOTO 11310
  3376. '
  3377. ' *****************************************************************************
  3378. ' *  S - COMMAND FROM 5- USER MAINTENANCE OPTIONS (CHANGE USER SECURITY)      *
  3379. ' *****************************************************************************
  3380. '
  3381. 11390 GOSUB 11395
  3382.       LSET SECURITY.LEVEL$ = MKI$(OF)
  3383.       GOTO 11290
  3384. 11395 A$ = "Enter security level"
  3385.       GOSUB 12995
  3386.       CALL ALLCAPSD (B$(),1)
  3387.       Z$ = B$(1)
  3388.       OF = VAL(Z$)
  3389.       IF OF > USER.SECURITY.LEVEL THEN _
  3390.          OF = USER.SECURITY.LEVEL
  3391.       RETURN
  3392. '
  3393. ' *****************************************************************************
  3394. ' *  R - COMMAND FROM 5- USER MAINTENANCE OPTIONS (RESET USER GRAPHICS)       *
  3395. ' *****************************************************************************
  3396. '
  3397. 11400 LSET USER.OPTIONS$ = LEFT$(USER.OPTIONS$,5) + _
  3398.                            "0" + _
  3399.                            MID$(USER.OPTIONS$,7)
  3400.       GOTO 11290
  3401. '
  3402. ' *****************************************************************************
  3403. ' *  $ - COMMAND FROM 5 - USER MAINTENANCE (CHANGE SUBSCRIPTION DATE)         *
  3404. ' *****************************************************************************
  3405. '
  3406. 11450 A$ = "Enter new subscription date"
  3407.       GOSUB 12995
  3408.       IF Q = 0 THEN _
  3409.          GOTO 11015
  3410.       DATE.HOLD$ = DATE$
  3411. 11455 DATE$ = B$(1)
  3412.       DATE$ = DATE.HOLD$
  3413.       WORK.DATE$ = B$(1)
  3414.       GOSUB 11470
  3415.       LSET USER.OPTIONS$ = LEFT$(USER.OPTIONS$,10) + _
  3416.                            REG.DATE$ + _
  3417.                            MID$(USER.OPTIONS$,13)
  3418.       GOSUB 11480
  3419.       GOTO 11290
  3420. '
  3421. ' *****************************************************************************
  3422. ' *  CALCULATE SUBSCRIPTION DATES                                             *
  3423. ' *****************************************************************************
  3424. '
  3425. 11470 IF LEN(WORK.DATE$) < 10 THEN _
  3426.          WORK.DATE$ = LEFT$(WORK.DATE$,6) + "19" + RIGHT$(WORK.DATE$,2)
  3427.       TODAY.REG.YY = VAL(MID$(WORK.DATE$,7))
  3428.       TODAY.REG.MM = VAL(LEFT$(WORK.DATE$,2))
  3429.       TODAY.REG.DD = VAL(MID$(WORK.DATE$,4,2))
  3430.       CALL TWOBYTEDATE (TODAY.REG.YY,TODAY.REG.MM,TODAY.REG.DD,REG.DATE$)
  3431.       RETURN
  3432. 11480 X$ = MID$(USER.OPTIONS$,11,2)
  3433.       IF CVI(X$) <> 0 THEN _
  3434.          REG.DATE$ = X$ : _
  3435.       ELSE GOSUB 11482
  3436.       CALL GETYMD (REG.DATE$,1,USER.REG.YY)
  3437.       CALL GETYMD (REG.DATE$,2,USER.REG.MM)
  3438.       CALL GETYMD (REG.DATE$,3,USER.REG.DD)
  3439.       REG.DISPLAY.DATE$ = RIGHT$("00"+MID$(STR$(USER.REG.MM),2),2) + _
  3440.                           "/" + _
  3441.                           RIGHT$("00"+MID$(STR$(USER.REG.DD),2),2) + _
  3442.                           "/" + _
  3443.                           RIGHT$(STR$(USER.REG.YY),2)
  3444.       IF CVI(X$) = 0 THEN _
  3445.          REG.DISPLAY.DATE$ = "00/00/00"
  3446.       RETURN
  3447. 11482 WORK.DATE$ = DATE$
  3448.       GOTO 11470
  3449. '
  3450. ' *****************************************************************************
  3451. ' *  ALLOW USERS TO ANSWER A "QUESTIONAIRE" BASED ON THE RBBS-PC SCRIPT FOR IT* ' CPC15-1B
  3452. ' *****************************************************************************
  3453. '
  3454. 11510 FILE.NAME$ = LEFT$(WELCOME.FILE$,2) + QUESTIONNAIRE$
  3455. 11520 CALL FINDIT (FILE.NAME$)
  3456.       IF NOT OK THEN _
  3457.          RETURN
  3458.       REDIM A$(256)
  3459.       CALL ASKUSERS
  3460.       REDIM A$(ADIM)
  3461.       IF SUBROUTINE.PARAMETER = - 1 THEN _
  3462.          RETURN 10595
  3463.       GOSUB 5135                                                     ' CPC15-1B
  3464.       RETURN
  3465. '
  3466. ' *****************************************************************************
  3467. ' *  A - COMMAND FROM 5- USER MAINTENANCE OPTIONS (ADD USER)                  *
  3468. ' *****************************************************************************
  3469. '
  3470. 12300 A1$ = ""
  3471.       ATTEMPTS = 0
  3472.       USER.SECURITY.LEVEL.SAVE = USER.SECURITY.LEVEL
  3473.       FIRST.NAME.SAVE$ = FIRST.NAME$
  3474.       LAST.NAME.SAVE$ = LAST.NAME$
  3475.       ACTIVE.USER.NAME.SAVE$ = ACTIVE.USER.NAME$
  3476.       CITY.STATE.SAVE$ = CI$
  3477.       HASH.VALUE.SAVE$ = HASH.VALUE$
  3478.       INDIV.VALUE.SAVE$ = INDIV.VALUE$
  3479.       GOSUB 12500
  3480.       GOSUB 12840
  3481.       GOSUB 12850
  3482.       GOSUB 12598
  3483.       IF USER.FILE.INDEX = 0 THEN _
  3484.          GOSUB 12984 : _
  3485.          GOTO 12330
  3486.       IF FOUND THEN _
  3487.          PRINT "User already exists" : _
  3488.          GOSUB 12984 : _
  3489.          GOTO 12330
  3490. 12310 GOSUB 12630
  3491.       GOSUB 12800
  3492.       GOSUB 11395
  3493.       TEMP.SECURITY.LEVEL = OF
  3494.       GOSUB 12900
  3495.       LSET LAST.DATE.TIME.ON$ = CURRENT.DATE$ + _
  3496.                                 " " + _
  3497.                                 TIME.LOGGED.ON$
  3498.       GOSUB 12960
  3499.       CALL ALLCAPSD (B$(),1)
  3500.       LSET CITY.STATE$ = B$(1)
  3501.       LSET ELAPSED.TIME$ = MKI$(0)
  3502.       IF START.HASH > 1 THEN _
  3503.          MID$(USER.RECORD$,START.HASH,LEN.HASH) = HASH.VALUE$
  3504.       IF START.INDIV > 1 THEN _
  3505.          MID$(USER.RECORD$,START.INDIV,LEN.INDIV) = INDIV.VALUE$
  3506.       PUT 5,USER.FILE.INDEX
  3507. 12320 GOSUB 12991
  3508. 12330 USER.SECURITY.LEVEL = USER.SECURITY.LEVEL.SAVE
  3509.       FIRST.NAME$ = FIRST.NAME.SAVE$
  3510.       LAST.NAME$ = LAST.NAME.SAVE$
  3511.       ACTIVE.USER.NAME$ = ACTIVE.USER.NAME.SAVE$
  3512.       CI$ = CITY.STATE.SAVE$
  3513.       HASH.VALUE$ = HASH.VALUE.SAVE$
  3514.       INDIV.VALUE$ = INDIV.VALUE.SAVE$
  3515.       USER.FILE.INDEX = TU
  3516.       GOTO 11000
  3517. '
  3518. ' *****************************************************************************
  3519. ' *  GET USER FIRST AND LAST NAMES                                            *
  3520. ' *****************************************************************************
  3521. '
  3522. 12500 IF ATTEMPTS > 5 THEN _
  3523.          FF = TRUE : _
  3524.          RETURN
  3525. 12510 GOSUB 12700
  3526.       ATTEMPTS = ATTEMPTS + 1
  3527.       A$ = A1$ + "FIRST Name"
  3528.       CALL SKIPLINE (1)
  3529.       GOSUB 12995
  3530.       IF Q = 0 THEN _
  3531.          GOTO 12500
  3532.       CALL ALLCAPSD (B$(),1)
  3533.       Z$ = B$(1)
  3534.       GOSUB 5100
  3535.       FIRST.NAME$ = LEFT$(Z$ + SPACE$(2),INSTR(Z$ +SPACE$(2),SPACE$(2))-1)
  3536.       IF Q <> 1 THEN _
  3537.          CALL ALLCAPSD (B$(),2) : _
  3538.          Z$ = B$(2) : _
  3539.          GOTO 12540
  3540. 12530 A$ = A1$ + "LAST Name"
  3541.       GOSUB 12995
  3542.       CALL ALLCAPSD (B$(),1)
  3543.       Z$ = B$(1)
  3544. 12540 GOSUB 5100
  3545.       LAST.NAME$ =LEFT$(Z$ + SPACE$(2),INSTR(Z$ +SPACE$(2),SPACE$(2))-1)
  3546.       IF LEN(LAST.NAME$) < 2 THEN _
  3547.          IF LEN(FIRST.NAME$) > 2 THEN _
  3548.             GOTO 12500
  3549.       IF (LEN(FIRST.NAME$) + LEN(LAST.NAME$)) > 30 THEN _
  3550.          GOTO 12500
  3551.       IF USER.SECURITY.LEVEL.SAVE < SYSOP.SECURITY.LEVEL THEN _
  3552.          IF (LEN(FIRST.NAME$) < 2 OR LEN(LAST.NAME$) < 2) THEN _
  3553.             GOTO 12500 _
  3554.          ELSE IF LEFT$(FIRST.NAME$,1)=" " OR LEFT$(LAST.NAME$,1)=" " THEN _
  3555.                  GOTO 12500
  3556. 12550 ACTIVE.USER.NAME$ = MID$(FIRST.NAME$ + " " + LAST.NAME$,1,31)
  3557.       IF HASH.INDIV > 1 THEN _                                       ' CPC15-1B
  3558.          IF Q<3 THEN _                                               ' CPC15-1B
  3559.             A$ = "Are you '" + ACTIVE.USER.NAME$ + "' ([Y],N)" : _   ' CPC15-1B
  3560.             GOSUB 12995 : _                                          ' CPC15-1B
  3561.             IF NO THEN _                                             ' CPC15-1B
  3562.                GOTO 12500                                            ' CPC15-1B
  3563.       Z$ = FIRST.NAME$
  3564.       RETURN
  3565. '
  3566. ' *****************************************************************************
  3567. ' *  CHECK FOR NAMES NOT ALLOWED                                              *
  3568. ' *****************************************************************************
  3569. '
  3570. 12570 FOUND = FALSE
  3571.       CALL OPENWORK (TRASHCAN.FILE$)
  3572.       IF EC = 53 THEN _
  3573.          GOTO 710
  3574. 12580 IF EOF(2) THEN _
  3575.          RETURN
  3576.       INPUT #2,INVALID.NAME$
  3577.       IF Z$ <> INVALID.NAME$ THEN _
  3578.          GOTO 12580
  3579.       FOUND = TRUE
  3580.       RETURN
  3581. 12595 CALL QTPUT ("Real name required. Call traced & recorded",1)
  3582.       GOTO 10621
  3583. '
  3584. ' *****************************************************************************
  3585. ' *  COMMON SEARCH USER FILE ROUTINE                                          *
  3586. ' *****************************************************************************
  3587. '
  3588. 12598 TEMP.HASH.VALUE$ = HASH.VALUE$
  3589.       TEMP.INDIV.VALUE$ = INDIV.VALUE$
  3590. 12600 GOSUB 4910
  3591.       GOSUB 12988
  3592.       IF NOT PRIVATE.DOOR THEN _
  3593.          CALL QTPUT ("Checking Users...",1)
  3594. 12605 CALL OPENUSER
  3595.       GOSUB 9450
  3596.       CALL FINDUSER (TEMP.HASH.VALUE$,TEMP.INDIV.VALUE$,START.HASH,LEN.HASH,_
  3597.                      START.INDIV,LEN.INDIV,HIGHEST.USER.RECORD,FOUND,_
  3598.                      USER.FILE.INDEX,SL)
  3599.      IF FOUND THEN _
  3600.         RETURN
  3601.      IF CURRENT.USER.COUNT < HIGHEST.USER.RECORD*.95 THEN _
  3602.         RETURN
  3603.       A$ = "No room for new users in " + GRN$
  3604.       CALL UPDTCALR (A$,2)
  3605.       IF REMEMBER.NEW.USERS AND NOT SURVIVE.NOUSER.ROOM THEN _
  3606.          GOSUB 1397
  3607.       USER.FILE.INDEX = 0
  3608.       IF SURVIVE.NOUSER.ROOM THEN _
  3609.          REMEMBER.NEW.USERS = FALSE
  3610.       RETURN
  3611. ' **********************************************************************
  3612. ' *  Augment user count, lock 4 rec block in user, unlock files        *
  3613. ' **********************************************************************
  3614. 12630 GOSUB 23000
  3615.       CURRENT.USER.COUNT = CURRENT.USER.COUNT+(SL = 0)*REMEMBER.NEW.USERS
  3616. 12632 GOSUB 24000
  3617.       GOSUB 12987
  3618.       IF REMEMBER.NEW.USERS THEN _
  3619.          GOSUB 12989
  3620.       GOSUB 12990
  3621.       RETURN
  3622. '
  3623. ' *****************************************************************************
  3624. ' *  INFORM USER OF WHAT CONFERENCE USER FILE HE IS VIEWING                   *
  3625. ' *****************************************************************************
  3626. '
  3627. 12700 IF CONFERENCE.MODE THEN _
  3628.          A$ = "Users of " + GRN$ + ":" : _
  3629.          GOSUB 12979
  3630.       RETURN
  3631. '
  3632. ' *****************************************************************************
  3633. ' *  GET PASSWORD FROM NEWUSER                                                *
  3634. ' *****************************************************************************
  3635. '
  3636. 12800 A$ = "Enter PASSWORD you'll use to logon again"
  3637.       GOSUB 12995
  3638.       IF USER.SECURITY.LEVEL.SAVE < SYSOP.SECURITY.LEVEL THEN _
  3639.          IF B$(1) = SPACE$(LEN(B$(1))) THEN _
  3640.             GOTO 12800
  3641.       IF LEN(B$(1)) > 15 THEN _
  3642.          CALL QTPUT ("15 Char. Max",1) : _
  3643.          GOTO 12800
  3644.       CALL ALLCAPSD (B$(),1)
  3645.       Z$ = B$(1)
  3646.       LSET PASSWORD$ = Z$
  3647.       RETURN
  3648. '
  3649. ' *****************************************************************************
  3650. ' *  GET HASH VALUE FOR CURRENT USER TO LOOK UP IN THE USER'S FILE            *
  3651. ' *****************************************************************************
  3652. '
  3653. 12840 IF START.HASH = 1 THEN _
  3654.          HASH.VALUE$ = ACTIVE.USER.NAME$:_
  3655.          RETURN
  3656.       X$ = A1$ + PROMPT.HASH$
  3657.       CALL UNTILRIGHT (X$,HASH.VALUE$,2,LEN.HASH)
  3658.       RETURN
  3659. '
  3660. ' *****************************************************************************
  3661. ' *  GET FIELD TO INDIVIDUATE ONE USER FROM ANOTHER (NAME FIELD IS DEFAULT)   *
  3662. ' *****************************************************************************
  3663. '
  3664. 12850 IF START.INDIV < 1 THEN _
  3665.          RETURN
  3666.       IF START.INDIV = 1 THEN _
  3667.          INDIV.VALUE$ = ACTIVE.USER.NAME$ : _
  3668.          RETURN
  3669.       X$ = A1$ + PROMPT.INDIV$
  3670.       CALL UNTILRIGHT (X$,INDIV.VALUE$,2,LEN.INDIV)
  3671.       RETURN
  3672. '
  3673. ' *****************************************************************************
  3674. ' *  ALWAYS RECORD THE HASH/INDIVIDUATING FIELD TO EACH RECORD LOGGED OUT     *
  3675. ' *****************************************************************************
  3676. '
  3677. 12860 X$ = "{" + HASH.VALUE$ + "/" + INDIV.VALUE$ + "}"
  3678.       IF LEN(Z$) < 65 THEN _
  3679.          X = 65 _
  3680.       ELSE X = LEN(Z$) + 2
  3681.       MID$(NG$,X) = X$
  3682.       RETURN
  3683. '
  3684. ' *****************************************************************************
  3685. ' *  SET NEWUSER DEFAULTS                                                     *
  3686. ' *****************************************************************************
  3687. '
  3688. 12900 LSET USER.NAME$ = ACTIVE.USER.NAME$
  3689.       LSET USER.OPTIONS$ = MKI$(0) + _
  3690.                            MKI$(0) + _
  3691.                            " 0" + _
  3692.                            MKI$(64) + _
  3693.                            MKI$(16) + _
  3694.                            MKI$(0) + _
  3695.                            CHR$(23) + _
  3696.                            STRING$(1,0)
  3697.       LSET USER.DOWNLOADS$ = MKI$(0)
  3698.       LSET USER.UPLOADS$ = MKI$(0)
  3699.       LSET SECURITY.LEVEL$ = MKI$(TEMP.SECURITY.LEVEL)
  3700.       LSET ELAPSED.TIME$ = MKI$(0)
  3701.       RETURN
  3702. ' *****************************************************************************
  3703. ' *  GET CITY AND STATE FROM NEWUSER                                          *
  3704. ' *****************************************************************************
  3705. '
  3706. 12960 A$ = A1$ + "CITY and STATE"
  3707.       GOSUB 12995
  3708.       IF Q = 0 THEN _
  3709.          GOTO 12960
  3710.       IF B$(1) = SPACE$(LEN(B$(1))) THEN _
  3711.          GOTO 12960
  3712.       CALL ALLCAPSD (B$(),1)
  3713.       LSET CITY.STATE$ = B$(1)
  3714.       CI$ = B$(1) + SPACE$(2)
  3715.       RETURN
  3716. '
  3717. ' *****************************************************************************
  3718. ' *  S - COMMAND FROM 5 - USER MAINTENANCE OPTIONS (SCAN USERS)               *
  3719. ' *****************************************************************************
  3720. '
  3721. 12962 X = 0
  3722.       FF = FALSE
  3723.       A$ = "String to search"
  3724.       GOSUB 12998
  3725.       IF Q = 0 THEN _
  3726.          GOTO 11000
  3727.       CALL ALLCAPSD (B$(),1)
  3728.       WK$ = B$(1)
  3729.       IF SCAN.FUNCTION$ = "L" THEN _
  3730.          WK$ = ","+STR$(VAL(WK$))+","
  3731. 12963 GET 5,I
  3732.       GOSUB 12966
  3733.       X = INSTR(SCAN.FIELD$,WK$)
  3734.       IF X > 0 THEN _
  3735.          GOTO 11015
  3736. 12965 I = I + 1
  3737.       IF I > HIGHEST.USER.RECORD-1 THEN _
  3738.          GOTO 11000
  3739.       X = 0
  3740.       GOTO 12963
  3741. 12966 FF = INSTR("NCPL",SCAN.FUNCTION$)
  3742. 12967 ON FF GOTO 12968,12969,12970,12972
  3743.       GOTO 11000
  3744. '
  3745. ' *****************************************************************************
  3746. ' *  N - COMMAND FROM 5 - USER MAINTENANCE SCAN FUNCTION (SEARCH FOR NAME)    *
  3747. ' *****************************************************************************
  3748. '
  3749. 12968 SCAN.FIELD$ = USER.NAME$
  3750.       RETURN
  3751. '
  3752. ' *****************************************************************************
  3753. ' *  C - COMMAND FROM 5 - USER MAINTENANCE SCAN FUNCTION (SEARCH FOR CITY/ST) *
  3754. ' *****************************************************************************
  3755. '
  3756. 12969 SCAN.FIELD$ = CITY.STATE$
  3757.       RETURN
  3758. '
  3759. ' *****************************************************************************
  3760. ' *  P - COMMAND FROM 5 - USER MAINTENANCE SCAN FUNCTION (SEARCH FOR PASSWORD)*
  3761. ' *****************************************************************************
  3762. '
  3763. 12970 SCAN.FIELD$ = PASSWORD$
  3764.       RETURN
  3765. '
  3766. ' *****************************************************************************
  3767. ' *  L - COMMAND FROM 5 - USER MAINTENANCE SCAN FUNCTION (SEARCH FOR LEVEL)   *
  3768. ' *****************************************************************************
  3769. '
  3770. 12972 SCAN.FIELD$ = ","+STR$(CVI(SECURITY.LEVEL$))+","
  3771.       RETURN
  3772. '
  3773. ' *****************************************************************************
  3774. ' * CALLS INTO SEPEARATELY COMPILED SUBROUTINES (RBBS-SUB)                    *
  3775. ' *****************************************************************************
  3776. '
  3777. '
  3778. ' *****************************************************************************
  3779. ' * STANDARD ENTRY FOR RBBS-PC'S COMMON TERMINAL OUTPUT ROUTINE               *
  3780. ' *****************************************************************************
  3781. '
  3782. 12975 SUBROUTINE.PARAMETER = 1
  3783.       GOTO 12981
  3784. 12976 SUBROUTINE.PARAMETER = 2
  3785.       GOTO 12981
  3786. 12977 SUBROUTINE.PARAMETER = 3
  3787.       GOTO 12981
  3788. 12978 SUBROUTINE.PARAMETER = 4
  3789.       GOTO 12981
  3790. 12979 SUBROUTINE.PARAMETER = 5
  3791.       GOTO 12981
  3792. 12980 SUBROUTINE.PARAMETER = 6
  3793. 12981 IF USER.DATA THEN _
  3794.          PRINT A$ : _
  3795.          RETURN
  3796.       CALL TPUT
  3797. 12983 IF SUBROUTINE.PARAMETER = -1 THEN _
  3798.          GOTO 10595
  3799.       IF FUNCTION.KEY <>0 THEN _
  3800.          GOSUB 60010 : _
  3801.          SUBROUTINE.PARAMETER = 7 : _
  3802.          FUNCTION.KEY = 0 : _
  3803.          GOTO 12981
  3804.       IF SUBROUTINE.PARAMETER = 8 THEN _
  3805.          GOSUB 12995
  3806.       RETURN
  3807. '
  3808. ' *****************************************************************************
  3809. ' * STANDARD ENTRY FOR RBBS-PC'S FILE LOCKING WHEN RUNNING MULTIPLE RBBS-PC'S *
  3810. ' *****************************************************************************
  3811. '
  3812. 12984 SUBROUTINE.PARAMETER = 1
  3813.       GOTO 12994
  3814. 12985 SUBROUTINE.PARAMETER = 2
  3815.       GOTO 12994
  3816. 12986 SUBROUTINE.PARAMETER = 3
  3817.       GOTO 12994
  3818. 12987 SUBROUTINE.PARAMETER = 4
  3819.       GOTO 12994
  3820. 12988 SUBROUTINE.PARAMETER = 5
  3821.       GOTO 12994
  3822. 12989 SUBROUTINE.PARAMETER = 6
  3823.       GOTO 12994
  3824. 12990 SUBROUTINE.PARAMETER = 7
  3825.       GOTO 12994
  3826. 12991 SUBROUTINE.PARAMETER = 8
  3827.       GOTO 12994
  3828. 12992 SUBROUTINE.PARAMETER = 9
  3829.       GOTO 12994
  3830. 12993 SUBROUTINE.PARAMETER = 10
  3831. 12994 CALL FILELOCK
  3832.       IF SUBROUTINE.PARAMETER = -1 THEN _
  3833.          GOTO 31000
  3834.       RETURN
  3835. '
  3836. ' *****************************************************************************
  3837. ' * STANDARD ENTRY FOR RBBS-PC'S COMMON TERMINAL INPUT ROUTINE                *
  3838. ' *****************************************************************************
  3839. '
  3840. 12995 SUBROUTINE.PARAMETER = 1
  3841. 12996 CALL TGET
  3842. 12997 IF SUBROUTINE.PARAMETER = -1 THEN _
  3843.          GOTO 10595
  3844.       IF FUNCTION.KEY <>0 THEN _
  3845.          GOSUB 60010 : _
  3846.          SUBROUTINE.PARAMETER = 2 : _
  3847.          FUNCTION.KEY = 0 : _
  3848.          GOTO 12996
  3849.       RETURN
  3850. 12998 A$ = A$ + PRESS.ENTER$
  3851.       GOTO 12995
  3852. '
  3853. ' *****************************************************************************
  3854. ' *  MAIN SYSTEM ERROR TRAP - ALL ERRORS PASS THROUGH THIS ROUTINE            *
  3855. ' *****************************************************************************
  3856. '
  3857. 13000 IF DEBUG THEN _
  3858.          A$ = "RBBS-PC DEBUG Error Trap Entry ERL=" + _
  3859.               STR$(ERL) + _
  3860.               " ERR=" + _
  3861.               STR$(ERR) : _
  3862.          IF PRINTER THEN _
  3863.             LPRINT A$ _
  3864.          ELSE PRINT A$
  3865.       IF ERR = 0 THEN _
  3866.          GOTO 13540
  3867.       IF ERR = 7 THEN _
  3868.          GOTO 13650
  3869. 13010 IF ERL = 110 THEN _
  3870.          CALLERS.FILE.INDEX = 0 : _
  3871.          RESUME 112
  3872. 13033 IF ERL = 821 AND ERR = 5 THEN _
  3873.          RESUME 832
  3874. 13035 IF ERL = 1905 AND ERR = 63 THEN _
  3875.          CLOSE 1 : _
  3876.          KILL ACTIVE.MESSAGE.FILE$ : _
  3877.          RESUME 5350
  3878. 13038 IF ERL = 4371 AND ERR = 6 THEN _
  3879.          RESUME 1200
  3880. 13045 IF ERL = 5130 AND ERR = 63 THEN _
  3881.          RESUME 5160
  3882. 13047 IF ERL = 5151 AND ERR = 62 THEN _
  3883.          RESUME 5160
  3884.       IF ERL = 11455 THEN _
  3885.          CALL QTPUT ("New subscription date invalid!",1) : _
  3886.          RESUME 11450
  3887. 13087 IF ERL = 20242 AND ERR = 62 THEN _
  3888.          RESUME 20247
  3889. 13090 IF ERR = 58 THEN _
  3890.          GOTO 13190
  3891. 13100 CALL FINDTIME (TI!)
  3892.       IF (ERR = EC AND (TI! - TKA! < 5)) THEN _
  3893.          EA = EA + 1 : _
  3894.          IF EA > 10 THEN _
  3895.             GOTO 13800
  3896. 13120 EC = ERR
  3897.       CALL FINDTIME (TI!)
  3898.       IF TI! - TKA! > 5 THEN _
  3899.          EA = 0 _
  3900.       ELSE CALL FINDTIME(TKA!)
  3901. 13190 IF ERL = 20840 OR _
  3902.          ERL = 21281 OR _
  3903.          ERL = 21360 OR _
  3904.          ERL = 21420 THEN _
  3905.          SUBROUTINE.PARAMETER = 1 : _
  3906.          CALL DELAYIT (1) : _
  3907.          CALL CARRIER : _
  3908.          IF SUBROUTINE.PARAMETER THEN _
  3909.             RESUME 10595
  3910. 13225 IF ERL = 4740 THEN _
  3911.          RESUME 4745
  3912. 13260 IF ERL = 7110 THEN _
  3913.          RESUME 6080
  3914. 13270 IF ERL = 7130 AND ERR = 52 THEN _
  3915.          RESUME 7260
  3916.       IF ERL = 20262 THEN _
  3917.          RESUME 20263
  3918.       IF ERL = 21480 THEN _
  3919.          CALL LOGERROR : _
  3920.          IF ERR=57 THEN _
  3921.             CALL QTPUT("Error reading file.  Aborting download",1):_
  3922.             DOWNLOAD.COMPLETED = FALSE :_
  3923.             RESUME 21230
  3924. 13390 IF ERL = 20452 AND ERR = 53 THEN _
  3925.          RESUME 20451
  3926.       IF ERL = 20560 AND ERR = 67 THEN _
  3927.          RESUME 20451
  3928.       IF ERL = 20452 THEN _
  3929.          A$ = "Unable to delete file.  ERROR"+STR$(ERR):_
  3930.          GOSUB 12979:_
  3931.          RESUME 20453
  3932. 13395 IF ERL = 20560 AND ERR = 70 THEN _
  3933.          IF VAL(FREE.SPACE$) > 1999 THEN _
  3934.             RESUME 20451 _
  3935.          ELSE GOSUB 13417 : _
  3936.               RESUME 5160
  3937. 13396 IF ERL = 20610 AND ERR = 57 THEN _
  3938.          LINE.STATUS = INP(LINE.STATUS.REGISTER) : _
  3939.          RESUME 20610
  3940. 13400 IF ERL = 20620 THEN _
  3941.          RESUME 20670
  3942. 13405 IF ERL = 20736 AND ERR = 53 THEN _
  3943.          RESUME 5160
  3944. 13410 IF ERL = 20840 THEN _
  3945.          LINE.STATUS = INP(LINE.STATUS.REGISTER) : _
  3946.          RESUME 20840
  3947. 13415 IF ERL = 20900 AND ERR = 70 THEN _
  3948.          GOSUB 13417 : _
  3949.          RESUME 21230
  3950.       IF ERL = 20900 AND ERR = 75 THEN _
  3951.          RESUME 21230
  3952.       GOTO 13420
  3953. 13417 CALL QTPUT ("No room for uploads.  Try tomorrow.",1)
  3954.       RETURN
  3955. 13420 IF ERL = 21131 THEN _
  3956.          RESUME 21230
  3957. 13430 IF ERL = 21281 THEN _
  3958.          LINE.STATUS = INP(LINE.STATUS.REGISTER) : _
  3959.          RESUME 21281
  3960. 13440 IF ERL = 21360 THEN _
  3961.          LINE.STATUS = INP(LINE.STATUS.REGISTER) : _
  3962.          RESUME 21360
  3963. 13442 IF ERL = 21420 THEN _
  3964.          LINE.STATUS = INP(LINE.STATUS.REGISTER) : _
  3965.          RESUME 21420
  3966. 13447 IF ERL = 53101 THEN _
  3967.          IF ERR = 53 OR ERR = 64 OR ERR = 68 THEN _
  3968.             RESUME 5160
  3969. 13450 IF 65535! = ERL THEN _
  3970.          GOTO 13800
  3971. 13460 IF ERR = 5 OR ERR = 6 THEN _
  3972.          GOTO 10595
  3973. 13470 IF ERR = 57 OR ERR = 24 OR ERR = 25 THEN _
  3974.          CALL DELAYIT (1) : _
  3975.          CALL CARRIER : _
  3976.          IF SUBROUTINE.PARAMETER THEN _
  3977.             RESUME 10595
  3978. 13480 IF ERR = 61 OR EC = 61 THEN _
  3979.          A$ = "* Disk full - terminating *" : _
  3980.          GOSUB 12976 : _
  3981.          GOSUB 33090 : _
  3982.          GOTO 31005
  3983. 13490 IF ERR = 71 THEN _
  3984.          GOSUB 13630 : _
  3985.          RESUME 1205
  3986. 13500 CALL LOGERROR
  3987.       ' print "untrapped error";str$(err);" on ";str$(erl)
  3988.       CALL QTPUT (CALLERS.RECORD$,1)
  3989.       RESUME 1200
  3990. '
  3991. ' *****************************************************************************
  3992. ' * COMMON EXIT FROM RBBS-PC (I.E. "ABANDON ALL HOPE OH YE WHO ENTER HERE")   *
  3993. ' *****************************************************************************
  3994. '
  3995. 13540 IF LOCAL.USER THEN _
  3996.          IF NOT LOCAL.USER.MODE THEN _
  3997.             GOTO 13549
  3998. 13543 IF NOT SYSOP THEN _
  3999.          IF (USER.FILE.INDEX = 0 AND REMEMBER.NEW.USERS) OR _
  4000.              NEW.USER = TRUE THEN _
  4001.              GOTO 13549
  4002. 13545 CALL UPDATEC
  4003. 13549 GOSUB 13700
  4004.       GOSUB 13555
  4005.       GOSUB 12986
  4006.       CALL OPENMSG
  4007.       IF EC = 64 THEN _
  4008.          EC = 0 : _
  4009.          GOTO 5360
  4010.       FIELD 1,128 AS MESSAGE.RECORD$
  4011.       GET 1,NODE.RECORD.INDEX
  4012.       EXIT.TO.DOORS = FALSE
  4013.       MID$(MESSAGE.RECORD$,57,1) = "I"
  4014.       MID$(MESSAGE.RECORD$,40,2) = STR$(EXIT.TO.DOORS)
  4015.       PUT 1,NODE.RECORD.INDEX
  4016.       GOSUB 12985
  4017. 13550 CLOSE 1,2,5
  4018.       CALL CARRIER
  4019.       IF NOT LOCAL.USER THEN _                                       ' CPC15-1B
  4020.          GOTO 13552                                                  ' CPC15-1B
  4021.       IF NOT SUBROUTINE.PARAMETER THEN _
  4022.          OUT MODEM.CONTROL.REGISTER,INP(MODEM.CONTROL.REGISTER AND 254) : _
  4023.          CALL DELAYIT (DTR.DROP.DELAY)
  4024. 13552 IF NOT LOCAL.USER THEN _
  4025.          CALL MODEMPUT (MODEM.GO.OFFHOOK.COMMAND$)
  4026. 13553 CLOSE 1,2,3,4,5
  4027.       IF RECYCLE.TO.DOS THEN _
  4028.      GOTO 31005
  4029.       RUN 100
  4030. 13555 IF LOCAL.USER THEN _
  4031.          RETURN
  4032. 13560 CALL DELAYIT (3)
  4033.       OUT MODEM.CONTROL.REGISTER,INP(MODEM.CONTROL.REGISTER) AND 254
  4034.       CALL DELAYIT (DTR.DROP.DELAY)
  4035.       OUT MODEM.CONTROL.REGISTER,INP(MODEM.CONTROL.REGISTER) OR 1
  4036.       RETURN
  4037. 13600 CLS
  4038.       LOCATE ,,0
  4039.       PRINT DF$;" file not found/invalid.  Run CONFIG."
  4040.       CALL DELAYIT (3)
  4041.       GOTO 31000
  4042. 13630 CALL QTPUT("File Menu missing",1)
  4043.       RETURN
  4044. 13650 CLS
  4045.       LOCATE ,,0
  4046.       PRINT "Not enough memory for RBBS"
  4047.       CALL DELAYIT (3)
  4048.       GOTO 31000
  4049. 13700 IF MESSAGE.FILE.LOCK THEN _
  4050.          GOSUB 12987
  4051. 13710 IF USER.FILE.LOCK THEN _
  4052.          GOSUB 12990
  4053. 13720 IF USER.BLOCK.LOCK THEN _
  4054.          GOSUB 12991
  4055.       RETURN
  4056. '
  4057. ' *****************************************************************************
  4058. ' *  FATAL ERROR HAS OCCURED!  RECYCLE SYSTEM IMMEDIATELY                     *
  4059. ' *****************************************************************************
  4060. '
  4061. 13800 A$ = "Fatal error!"
  4062.       GOSUB 12979
  4063.       GOTO 10595
  4064. '
  4065. ' *****************************************************************************
  4066. ' *         TAKE THE PHONE OFF THE HOOK FOR LOCAL SYSOP MAINTENANCE           *
  4067. ' *****************************************************************************
  4068. '
  4069. 14498 CLOSE 3
  4070.       CALL OPENCOM(MODEM.INIT.BAUD$,",N,8,1")                        ' CPC15-1B
  4071. 14500 CALL MODEMPUT (MODEM.GO.OFFHOOK.COMMAND$)
  4072.       RETURN
  4073. '
  4074. ' *****************************************************************************
  4075. ' *  C/R - COMMAND FROM 5 - USER MAINTENANCE SCAN FUNCTION (QUIT TO MAIN MENU)*
  4076. ' *****************************************************************************
  4077. '
  4078. 20093 IF USER.FILE.INDEX > 0 THEN _
  4079.          CALL OPENUSER : _
  4080.          GOSUB 9450 : _
  4081.          GET 5,USER.FILE.INDEX : _
  4082.          GOSUB 9500
  4083. 20095 RETURN 1200
  4084. '
  4085. ' *****************************************************************************
  4086. ' *  V - COMMAND FROM FILES MENU (VIEW ARC CONTENTS)                          *
  4087. ' *****************************************************************************
  4088. '
  4089. 20140 IF Q > 1 THEN _
  4090.          B = 2 : _
  4091.          GOTO 20142
  4092. 20141 A$ = "Enter ARCed file(s) to list"
  4093.       GOSUB 12995
  4094.       B = 1
  4095.       IF Q = 0 THEN _
  4096.          RETURN
  4097. 20142 LAST.ARC = Q
  4098.       FIRST.ARC = B
  4099.       VIOLATION$ = "View ARC"
  4100.       FOR ARC.INDEX = FIRST.ARC TO LAST.ARC
  4101.           GOSUB 20143
  4102.       NEXT
  4103.       RETURN
  4104. 20143 Z$ = B$(ARC.INDEX)
  4105.       CALL ALLCAPS (Z$)
  4106.       CALL BRKFNAME (Z$,DRV$,PREFIX$,EXT$,FALSE)
  4107.       IF EXT$ = "" THEN _
  4108.          Z$ = Z$ + ".ARC"_
  4109.       ELSE_
  4110.         IF EXT$ <> "ARC" THEN _
  4111.            CALL QTPUT ("Only .ARC files can be viewed",1) : _
  4112.            RETURN
  4113.       FILE.NAME.HOLD$ = Z$
  4114.       FILE.NAME$ = Z$
  4115.       CALL BADFILE (FILE.NAME$,BAD.FILE.NAME.INDEX)
  4116.       ON BAD.FILE.NAME.INDEX GOTO 20144,20146,20147
  4117. 20144 CALL ROTORSDIR (FILE.NAME$,SUBDIR$(),SUBDIR.COUNT+(NOT SYSOP))
  4118.       IF OK THEN _
  4119.          GOTO 20148
  4120. 20146 Z$ = B$(ARC.INDEX) + " not found!"
  4121.       CALL UPDTCALR (Z$,2)
  4122.       A$ = Z$ + " Type correct filename ([Enter] Quits)"
  4123.       GOSUB 12995
  4124.       IF Q = 0 THEN _
  4125.          RETURN
  4126.       B$(ARC.INDEX) = B$(1)
  4127.       GOTO 20143
  4128. 20147 GOSUB 1380
  4129.       GOTO 20146
  4130. 20148 CALL QTPUT(FILE.NAME.HOLD$ + " contains the following files.",1)
  4131.       CALL VIEWARC
  4132.       IF SUBROUTINE.PARAMETER = -1 THEN _
  4133.          GOTO 13540
  4134.       RETURN
  4135. '
  4136. ' *****************************************************************************
  4137. ' *  L - COMMAND FROM FILES MENU (LIST DIRECTORY)                             *
  4138. ' *****************************************************************************
  4139. '
  4140. 20150 LIST.DIRECTORY = TRUE
  4141.       SEARCH.DATE$ = ""
  4142.       SEARCH.STRING$ = ""
  4143.       CK = 0
  4144.       IF Q > 1 THEN _
  4145.          LIST.INDEX = 2:_
  4146.          GOTO 20160
  4147.       LIST.INDEX = 1
  4148.       CALL GETDIRS ("for menu")
  4149.       IF Q = 0 THEN _
  4150.          Q = 1 : _
  4151.          B$(Q) = DIRECTORY.EXTENTION$
  4152. 20160 CALL CONVDIRS (LIST.INDEX)
  4153.       QX = Q
  4154. 20161 IF LIST.INDEX > QX THEN _
  4155.         IF NO OR (FILE.NAME.HOLD$=DIRECTORY.EXTENTION$) THEN _
  4156.            REDIM A$(ADIM) : _
  4157.            REDIM B$(ADIM) : _
  4158.            RETURN _
  4159.            ELSE X$ = B$(LIST.INDEX-1) :_
  4160.                 A$="End list.  R)elist, [Q]uit, or file(s) to download" :_
  4161.                 GOSUB 12995 : _
  4162.                 CALL ALLCAPSD (B$(),1) : _
  4163.                 IF B$(1)="R" THEN _
  4164.                    LIST.INDEX = LIST.INDEX - 1 : _
  4165.                    B$(LIST.INDEX) = X$ _
  4166.                 ELSE IF LEN(B$(1)) > 1 AND _
  4167.                         USER.SECURITY.LEVEL => OPT.SEC(18) THEN _
  4168.                         B = 1 : _
  4169.                         GOSUB 20202 : _
  4170.                         RETURN _
  4171.                      ELSE RETURN
  4172.       IF INSTR(B$(LIST.INDEX),".") THEN _
  4173.          GOTO 20172
  4174.       VIOLATION$ = "List Dir. "
  4175.       Z$ = B$(LIST.INDEX)
  4176.       CALL ALLCAPS(Z$)
  4177.       FILE.NAME.HOLD$ = Z$
  4178.       IF Z$ = DIRECTORY.EXTENTION$ THEN _
  4179.          GOTO 20164
  4180.       FOR I = 2 TO QX
  4181.           A$(I) = B$(I)
  4182.       NEXT
  4183.       CALL FMS (Z$,SEARCH.STRING$,SEARCH.DATE$,IN.FMS, _
  4184.                 CATEGORY.NAME$(),CATEGORY.CODE$(),CATEGORY.DESC$(),_
  4185.                 DOWNLOAD.FLAG,CAT.FOUND)
  4186.       WHILE DOWNLOAD.FLAG > 0 AND SUBROUTINE.PARAMETER > -1
  4187.          B = 1
  4188.          GOSUB 20202
  4189.          X$ = CATEGORY.CODE$(CAT.FOUND)
  4190.          CALL DISUPDIR (X$,SEARCH.STRING$,SEARCH.DATE$,DOWNLOAD.FLAG)
  4191.          GOSUB 41000
  4192.          CALL CARRIER
  4193.       WEND
  4194.       IF SUBROUTINE.PARAMETER = -1 THEN _
  4195.          RETURN 10595
  4196.       FOR I = 2 TO QX
  4197.           B$(I) = A$(I)
  4198.       NEXT
  4199.       IF IN.FMS THEN _
  4200.          GOTO 20175
  4201.       IF USER.SECURITY.LEVEL < MIN.SEC.TO.VIEW THEN _
  4202.          IF FILE.NAME.HOLD$ = UPLOAD.DIR.CHECK$ THEN _
  4203.             FILE.NAME.HOLD$ = "of uploads" : _
  4204.             GOTO 20172
  4205.       FILE.NAME.HOLD$ = B$(LIST.INDEX)
  4206.       IF LIMIT.SEARCH.TO.FMS THEN _
  4207.          GOTO 20172
  4208.       IF FILE.NAME.HOLD$ = "ALL" OR FILE.NAME.HOLD$ = "A" THEN _
  4209.          DIR.INDEX = LIST.INDEX : _
  4210.          GOTO 53070
  4211.       CALL BADFILE (FILE.NAME.HOLD$,BAD.FILE.NAME.INDEX)
  4212.       ON BAD.FILE.NAME.INDEX GOTO 20163,20172,20176
  4213. 20163 FILE.NAME$ = FILE.NAME.HOLD$
  4214.       CALL BADNAME (BAD.FILE.NAME.INDEX)                             ' CPC15-1B
  4215.       ON BAD.FILE.NAME.INDEX GOTO 20164,20176
  4216. 20164 IF FILE.NAME$ = UPLOAD.DIR.CHECK$ AND _
  4217.          USER.SECURITY.LEVEL >= MIN.SEC.TO.VIEW THEN _
  4218.            FILE.NAME$ = UPLOAD.PATH$ _
  4219.       ELSE FILE.NAME$ = DIRECTORY.PATH$
  4220.       FILE.NAME$ = FILE.NAME$ + _
  4221.                    FILE.NAME.HOLD$ + _
  4222.                    "." + _
  4223.                    DIRECTORY.EXTENTION$
  4224.       GOSUB 43030
  4225. 20165 CALL FINDIT (FILE.NAME$)
  4226.       IF NOT OK THEN _
  4227.          GOTO 20172
  4228. 20167 B$(0) = B$(LIST.INDEX)
  4229.       IF LIST.NEW THEN _
  4230.          GOSUB 7000 : _
  4231.          IF NO THEN _
  4232.             QX = LIST.INDEX : _
  4233.             GOTO 20170 _
  4234.          ELSE GOTO 20170
  4235.       CALL BUFFILE(FILE.NAME$)
  4236.       CALL CARRIER
  4237.       IF SUBROUTINE.PARAMETER = -1 THEN _
  4238.          GOTO 10595
  4239. 20170 B$(LIST.INDEX) = B$(0)
  4240.       GOTO 20175
  4241. 20172 A$ = "Directory " + FILE.NAME.HOLD$ + " not found!"
  4242.       GOSUB 12977
  4243.       NO = TRUE
  4244. 20175 LIST.INDEX = LIST.INDEX + 1
  4245.       GOTO 20161
  4246. 20176 GOSUB 1380
  4247.       GOTO 20172
  4248. '
  4249. ' *****************************************************************************
  4250. ' *  D - COMMAND FROM FILES MENU (SEARCH FOR FILE TO DOWNLOAD)                *
  4251. ' *****************************************************************************
  4252. 20180 IF Q > 1 THEN _
  4253.          B = 2 : _
  4254.          GOTO 20202
  4255. 20200 A$ = "Name file(s) to " + _
  4256.             LEFT$("AUTO",-4*AUTODOWNLOAD.AVAILABLE) + "download"
  4257.       GOSUB 12995
  4258.       B = 1
  4259.       IF Q = 0 THEN _
  4260.          RETURN
  4261. 20202 LAST.DOWNLOAD = Q
  4262.       FIRST.DOWNLOAD = B
  4263.       COMMAND.TRANSFER$ = ""
  4264.       IF AUTODOWNLOAD.AVAILABLE THEN _
  4265.          COMMAND.TRANSFER$ = "X"
  4266.       AUTODOWNLOAD.IN.PROGRESS = AUTODOWNLOAD.AVAILABLE
  4267.       IF LAST.DOWNLOAD > FIRST.DOWNLOAD THEN _
  4268.          Z$ = B$(LAST.DOWNLOAD) : _
  4269.          CALL ALLCAPS(Z$) : _
  4270.          IF LEN (Z$) = 1 AND INSTR("AXCKYIGW",Z$) > 0 THEN _
  4271.             LAST.DOWNLOAD = LAST.DOWNLOAD - 1 : _
  4272.             COMMAND.TRANSFER$ = Z$ : _
  4273.             AUTODOWNLOAD.IN.PROGRESS = FALSE
  4274.       START.DRIVE = 1
  4275.       IF LAST.DOWNLOAD > FIRST.DOWNLOAD THEN _
  4276.          START.DRIVE = VAL(B$(FIRST.DOWNLOAD + 1)) : _
  4277.          IF START.DRIVE < 1 THEN _
  4278.             START.DRIVE = 1
  4279.       FOR DWN.INDEX = FIRST.DOWNLOAD TO LAST.DOWNLOAD
  4280.          GOSUB 20205
  4281. 20203 NEXT
  4282.       COMMAND.TRANSFER$ = ""
  4283.       RETURN
  4284. 20205 CALL QTPUT ("Searching for file...",1)
  4285.       FILE.NAME.HOLD$ = B$(DWN.INDEX)
  4286.       FILE.NAME$ = FILE.NAME.HOLD$
  4287.       VIOLATION$ = "Download "
  4288.       CALL BADFILE (FILE.NAME$,BAD.FILE.NAME.INDEX)
  4289.       ON BAD.FILE.NAME.INDEX GOTO 20220,20231,20233
  4290. 20220 CALL ROTORSDIR (FILE.NAME$,SUBDIR$(),SUBDIR.COUNT + _
  4291.                       ((USER.SECURITY.LEVEL < MIN.SEC.TO.VIEW) OR _
  4292.                        NOT CAN.DOWNLOAD.FROM.UP))
  4293. 20225 IF OK THEN _
  4294.          GOTO 20235
  4295. 20231 A$ = FILE.NAME.HOLD$ + " not found!"
  4296.       CALL UPDTCALR (A$,2)
  4297.       IF AUTODOWNLOAD.IN.PROGRESS THEN _
  4298.          A$ = A$ + " during AUTODOWNLOAD" : _
  4299.          GOSUB 12977 : _
  4300.          RETURN
  4301.       A$ = A$ + " Correct name ([ENTER] quits)"
  4302.       GOSUB 12995
  4303.       IF Q=0 THEN _
  4304.          RETURN
  4305.       B$(DWN.INDEX) = B$(1)
  4306.       GOTO 20205
  4307. 20233 GOSUB 1380
  4308.       GOTO 20231
  4309. 20235 CALL BADNAME (BAD.FILE.NAME.INDEX)                             ' CPC15-1B
  4310.       ON BAD.FILE.NAME.INDEX GOTO  20236,20245
  4311. 20236 LINE.25$ = "(D) " + Z$
  4312.       IF AUTODOWNLOAD.IN.PROGRESS THEN _
  4313.          MID$(LINE.25$,2,1)="A"
  4314. '
  4315. ' *****************************************************************************
  4316. ' *  TEST FOR DOWNLOAD SECURITY                                               *
  4317. ' *****************************************************************************
  4318. '
  4319.       CALL OPENWORK (FILESEC.FILE$)
  4320.       IF EC = 53 THEN _
  4321.          CALL UPDTCALR ("Missing file " + FILESEC.FILE$,2) : _
  4322.          GOTO 20247
  4323.       CALL BRKFNAME (Z$,YY$,A1$,RS$,FALSE)
  4324. 20242 IF EOF(2) THEN _
  4325.          GOTO 20247 _
  4326.       ELSE INPUT #2,N$,FILE.SECURITY,FILE.PASSWORD$ : _
  4327.            CALL BRKFNAME (N$,DR$,X$,EXTENTION$,FALSE)
  4328. 20243 IF DR$ <> "" AND DR$ <> YY$ THEN _
  4329.          GOTO 20242
  4330.       CALL WILDCARD (X$,A1$)
  4331.       IF NOT OK THEN _
  4332.          GOTO 20242
  4333.       CALL WILDCARD (EXTENTION$,RS$)
  4334.       IF NOT OK THEN _
  4335.          GOTO 20242
  4336. 20244 IF USER.SECURITY.LEVEL < FILE.SECURITY THEN _
  4337.          GOTO 20245
  4338.       IF FILE.PASSWORD$ = "" THEN _
  4339.          GOTO 20247
  4340.       CALL ALLCAPS (FILE.PASSWORD$)
  4341.       IF FILE.PASSWORD$ = PASSWORD$ THEN _
  4342.          GOTO 20247
  4343.       A$ = "Enter PASSWORD to download " + FILE.NAME$
  4344.       GOSUB 12995
  4345.       IF Q = 0 THEN _
  4346.          RETURN
  4347.       CALL ALLCAPSD (B$(),1)
  4348.       IF B$(1) = FILE.PASSWORD$ THEN _
  4349.          GOTO 20247
  4350. 20245 VIOLATION$ = "DownLoad " + FILE.NAME$
  4351. 20246 GOSUB 1380
  4352.       RETURN
  4353. 20247 DF = 0
  4354.       CALL BRKFNAME (FILE.NAME$,DR$,X$,EXTENTION$,FALSE)
  4355.       IF AUTODOWNLOAD.IN.PROGRESS THEN _
  4356.          A$ = "Transferring -- " + B$(DWN.INDEX) : _
  4357.          GOSUB 12977
  4358.       IF EXTENTION$ = "" OR RELIABLE.MODE THEN _
  4359.          GOTO 20248
  4360.       IF INSTR(".WRK.FW .ARC.EXE.COM.OBJ.WKS.LBR",EXTENTION$) OR _
  4361.          MID$(EXTENTION$,2,1) = "Q" OR _
  4362.          (REQUIRE.NON.ASCII AND EXTENTION$ = "BAS") THEN _
  4363.          CALL QTPUT ("Non-ASCII required for "+FILE.NAME.HOLD$,1) : _
  4364.          DF = TRUE
  4365. 20248 A$ = ""
  4366.       GOSUB 21620
  4367.       IF FF THEN _
  4368.          GOTO 20260
  4369.       GOSUB 21600
  4370. 20260 TRANSFER.FUNCTION = 1
  4371.       ON FF GOTO 20340, _      ' ASCII FILE DOWNLOAD
  4372.                  20290, _      ' XMODEM (CHECKSUM) FILE DOWNLOAD
  4373.                  20290, _      ' XMODEM (CRC-16) FILE DOWNLOAD
  4374.                  20265, _      ' KERMIT FILE DOWNLOAD
  4375.                  20261, _      ' YMODEM FILE DOWNLOAD
  4376.                  20261, _      ' IMODEM FILE DOWNLOAD
  4377.                  20261, _      ' YMODEMG FILE DOWNLOAD
  4378.                  20261, _      ' WXMODEM FILE DOWNLOAD
  4379.                  57120         ' NO FILE DOWNLOAD
  4380. '
  4381. ' *****************************************************************************
  4382. ' *  QMXFER PROTOCOL DOWNLOADS/UPLOADS                                        *
  4383. ' *****************************************************************************
  4384. '
  4385. 20261 IF NOT EIGHT.BIT THEN _
  4386.          A$ = "Please SWITCH to N,8,1 for binary transfer" : _
  4387.          GOSUB 12975 : _
  4388.          CALL DELAYIT (3) : _
  4389.          GOSUB 20992
  4390.       IF FF = 5 OR _
  4391.          FF > 6 THEN _
  4392.          BLOCK.SIZE = 8 _
  4393.       ELSE BLOCK.SIZE = 1
  4394.       IF TRANSFER.FUNCTION = 1 THEN _
  4395.          GOSUB 20750 : _
  4396.          CLOSE 2
  4397.       IF AUTODOWNLOAD.IN.PROGRESS THEN _
  4398.          CALL SENDNAME : _
  4399.          IF ABORT THEN _
  4400.             DOWNLOAD.COMPLETED = FALSE : _
  4401.             GOSUB 50600 : _
  4402.             RETURN
  4403.       CALL TRANSFER
  4404. 20262 OPEN "I",2,"XFER-" + RIGHT$(NODE.ID$,1) + ".DEF"
  4405.       INPUT #2,A$
  4406.       INPUT #2,A$
  4407.       INPUT #2,A$
  4408.       INPUT #2,A$
  4409.       IF TRANSFER.FUNCTION = 2 THEN _
  4410.          IF LEFT$(A$,1) = "S" THEN _
  4411.             GOTO 20700 _
  4412.          ELSE GOTO 20730
  4413.       IF TRANSFER.FUNCTION = 1 THEN _
  4414.          IF LEFT$(A$,1) = "S" THEN _
  4415.             DOWNLOAD.COMPLETED = TRUE _
  4416.          ELSE DOWNLOAD.COMPLETED = FALSE
  4417.       GOSUB 50600
  4418.       RETURN
  4419. '
  4420. ' *****************************************************************************
  4421. ' *  DOWNLOAD ABORT                                                           *
  4422. ' *****************************************************************************
  4423. '
  4424. 20263 A$ = "<Download aborted>"
  4425.       DOWNLOAD.COMPLETED = FALSE
  4426.       GOTO 20390
  4427. '
  4428. ' *****************************************************************************
  4429. ' *  KERMIT INTERFACE FOR DOWNLOADS & UPLOADS                                 *
  4430. ' *****************************************************************************
  4431. '
  4432. 20265 IF TRANSFER.FUNCTION = 1 THEN _
  4433.          BLOCK.SIZE = 1 : _
  4434.          GOSUB 20750
  4435. 20266 CLOSE 2
  4436.       CALL TRANSFER
  4437.       IF TRANSFER.FUNCTION = 2 THEN _
  4438.          GOTO 20700
  4439.       DOWNLOAD.COMPLETED = TRUE
  4440.       GOSUB 50600
  4441.       RETURN
  4442.  
  4443. '
  4444. ' *****************************************************************************
  4445. ' *  GET DRIVE ID AND FILENAME EXTENTION                                      *
  4446. ' *****************************************************************************
  4447. '
  4448. 20285 OK = FALSE
  4449.       K = 0
  4450.       L = LEN(A$)
  4451. 20286 K = K + 1
  4452.       IF K > L THEN _
  4453.          GOTO 20288
  4454.       B$ = MID$(Z$,K,1)
  4455.       IF B$ = "*" THEN _
  4456.          RETURN
  4457. 20287 IF B$ <> "?" AND MID$(A$,K,1) <> B$ THEN _
  4458.          OK = TRUE : _
  4459.          RETURN
  4460.       GOTO 20286
  4461. 20288 IF L < LEN(Z$) AND MID$(Z$,L + 1,1) <> "*" THEN _
  4462.          OK = TRUE
  4463.       RETURN
  4464. '
  4465. ' *****************************************************************************
  4466. ' *  XMODEM DOWNLOAD DRIVER                                                   *
  4467. ' *****************************************************************************
  4468. '
  4469. 20290 BLOCK.SIZE = 1
  4470.       IF USE.EXTERNAL.XMODEM THEN _
  4471.          GOTO 20261
  4472.       GOSUB 20750
  4473.       A1$ = "SEND"
  4474.       GOSUB 20320
  4475.       IF AUTODOWNLOAD.IN.PROGRESS THEN _
  4476.          CALL SENDNAME : _
  4477.          IF ABORT THEN _
  4478.             RETURN 20792
  4479.       GOSUB 21300
  4480.       A$ = ""
  4481.       GOTO 20390
  4482. 20320 IF NOT EIGHT.BIT THEN _
  4483.          A$ = "Please SWITCH to N,8,1 for binary transfer" : _
  4484.          GOSUB 12975 : _
  4485.          CALL DELAYIT (3)
  4486. 20325 XMODEM.TYPE$ = " ": _
  4487.       NEGATIVE.ACKNOWLEDGE$ = CHR$(21): _
  4488.       SOL = 132
  4489.       IF FT$ = "C" THEN _
  4490.          NEGATIVE.ACKNOWLEDGE$ = FT$: _
  4491.          SOL = 133: _
  4492.          XMODEM.TYPE$ = "/CRC "
  4493. 20330 IF AUTODOWNLOAD.IN.PROGRESS THEN _
  4494.          RETURN
  4495.       A$ = "XMODEM" + _
  4496.             XMODEM.TYPE$ + _
  4497.             A1$ + _
  4498.             " of " + _
  4499.             FILE.NAME.HOLD$ + _
  4500.             " ready.  <Ctrl X> aborts"
  4501.       GOSUB 12979
  4502.       RETURN
  4503. '
  4504. ' *****************************************************************************
  4505. ' *  ASCII DOWNLOAD DRIVER                                                    *
  4506. ' *****************************************************************************
  4507. '
  4508. 20340 IF DF THEN _
  4509.          A$ = "Switch to a non-ascii protocol" : _
  4510.          GOSUB 12979 : _
  4511.          RETURN
  4512.       CALL OPENWORK (FILE.NAME$)
  4513.       BLOCK.SIZE = 1
  4514.       GOSUB 20760
  4515.       A$ = "* <Ctrl X> aborts <Ctrl S> suspends *"
  4516.       GOSUB 12977
  4517.       A$ = "ASCII SEND of " + _
  4518.            FILE.NAME.HOLD$ + _
  4519.            " ready. Press [ENTER] to start"
  4520.       GOSUB 12995
  4521. 20380 STOP.INTERRUPTS = TRUE
  4522.       TU = 0
  4523.       SWAP TU,PAGE.LENGTH
  4524.       CALL BUFFILE (FILE.NAME$)
  4525.       SWAP TU,PAGE.LENGTH
  4526.       NON.STOP = (PAGE.LENGTH > 0) 'IS THIS CORRECT?
  4527.       IF STOP.FILE THEN _
  4528.          DOWNLOAD.COMPLETED = FALSE : _
  4529.          GOTO 20390
  4530. 20381 A$ = CHR$(26)
  4531.       GOSUB 12977
  4532.       CALL CARRIER
  4533.       IF NOT LOCAL.USER AND SUBROUTINE.PARAMETER = 0 THEN _
  4534.          FOR X = 1 TO 5 : _
  4535.            PRINT #3,CHR$(7) : _
  4536.            CALL DELAYIT (3) : _
  4537.          NEXT
  4538. 20385 DOWNLOAD.COMPLETED = TRUE
  4539. 20390 GOSUB 12977
  4540.       GOTO 50600
  4541. '
  4542. ' *****************************************************************************
  4543. ' *  U - COMMAND FROM FILES MENU (UPLOAD)                                     *
  4544. ' *****************************************************************************
  4545. '
  4546. 20395 GOSUB 12977
  4547.       A$ = "Correct name of file to upload"
  4548.       GOSUB 12995
  4549.       IF Q = 0 THEN _
  4550.          RETURN
  4551.       B$(ANS.INDEX) = B$(1)
  4552.       GOTO 20435
  4553. 20400 CALL TIMEREMAIN (TIME.REMAINING!)
  4554.       Q! = TCA!
  4555.       FIRST.UPLOAD = 1
  4556.       IF Q > 1 THEN _
  4557.          FIRST.UPLOAD = 2 : _
  4558.          GOTO 20430
  4559. 20420 A$ = "Name file(s) to upload"
  4560.       GOSUB 12995
  4561.       IF Q = 0 THEN _
  4562.          RETURN
  4563. '
  4564. ' *****************************************************************************
  4565. ' *  SEARCH FOR DUPLICATE FILENAME                                            *
  4566. ' *****************************************************************************
  4567. '
  4568. 20430 LAST.UPLOAD = Q
  4569.       Z$ = B$(LAST.UPLOAD)
  4570.       IF LEN(Z$) = 1 THEN _
  4571.         CALL ALLCAPS (Z$): _
  4572.         IF INSTR("AXCKYIGW ",Z$) > 0 THEN _
  4573.           LAST.UPLOAD = LAST.UPLOAD - 1:_
  4574.           COMMAND.TRANSFER$ = Z$
  4575.       FOR ANS.INDEX = FIRST.UPLOAD TO LAST.UPLOAD
  4576.         GOSUB 20435
  4577.       NEXT
  4578.       COMMAND.TRANSFER$ = ""
  4579.       RETURN
  4580. 20435 CALL QTPUT ("Searching for file...",1)
  4581.       FILE.NAME.HOLD$ = B$(ANS.INDEX)
  4582.       CALL ALLCAPS(FILE.NAME.HOLD$)
  4583.       FILE.NAME$ = FILE.NAME.HOLD$
  4584.       VIOLATION$ = "Upload "
  4585.       IF INSTR(FILE.NAME$,":") OR _
  4586.          INSTR(FILE.NAME$,"\") OR _
  4587.          INSTR(FILE.NAME$,"/") THEN _
  4588.          GOTO 20451
  4589.       CALL BADFILE (FILE.NAME$,BAD.FILE.NAME.INDEX)
  4590.       ON BAD.FILE.NAME.INDEX GOTO 20440,20451,20515
  4591. 20440 CALL ROTORSDIR (FILE.NAME$,SUBDIR$(),SUBDIR.COUNT)
  4592. 20450   IF OK THEN _
  4593.            GOTO 20452
  4594.         GOTO 20475
  4595. 20451   A$ = "Invalid file name"
  4596.         GOTO 20395
  4597. 20452   IF USER.SECURITY.LEVEL >= OVERWRITE.SECURITY.LEVEL THEN _
  4598.            A$ = "Overwrite file" : _
  4599.            GOSUB 12995 : _
  4600.            IF YES THEN _
  4601.               Z$ = FILE.NAME$ : _
  4602.               CLOSE 2 : _
  4603.               KILL FILE.NAME$ : _
  4604.               GOTO 20475
  4605. 20453   CLOSE 2
  4606.         A$ = FILE.NAME.HOLD$ + " exists! Please use a new name"
  4607.         GOTO 20395
  4608. 20475 Z$ = UPLOAD.DRIVE.FILE$
  4609.       GOSUB 12977
  4610.       CALL FINDFREE
  4611.       IF VAL(FREE.SPACE$) < 4096 THEN _
  4612.          GOSUB 13417: _
  4613.          ANS.INDEX = LAST.UPLOAD + 1:_
  4614.          RETURN
  4615.       A$ = "Upload disk has" + FREE.SPACE$
  4616.       GOSUB 12977
  4617.       LINE.25$ = "(U) " + FILE.NAME.HOLD$
  4618.       SUBROUTINE.PARAMETER = 2
  4619.       CALL LINE25
  4620.       A$ = ""
  4621.       OK = TRUE
  4622. 20477 GOSUB 21620
  4623.       IF FF THEN _
  4624.          GOTO 20500
  4625.       GOSUB 21600
  4626. 20500 TRANSFER.FUNCTION = 2
  4627.       AUTODOWNLOAD.IN.PROGRESS = FALSE                               ' CPC15-1B
  4628.       ON FF GOTO 20560, _      ' ASCII FILE UPLOAD
  4629.                  20540, _      ' XMODEM (CHECKSUM) FILE UPLOAD
  4630.                  20540, _      ' XMODEM (CRC-16) FILE UPLOAD
  4631.                  20265, _      ' KERMIT FILE UPLOAD
  4632.                  20261, _      ' YMODEM FILE UPLOAD
  4633.                  20261, _      ' IMODEM FILE UPLOAD
  4634.                  20261, _      ' YMODEMG FILE UPLOAD
  4635.                  20261, _      ' WXMODEM FILE UPLOAD
  4636.                  20735         ' NO FILE UPLOAD
  4637. 20510 IF SNOOP THEN _
  4638.          PRINT "<Esc> by SYSOP aborts"
  4639.       RETURN
  4640. 20515 GOSUB 1380
  4641.       RETURN 20420
  4642. '
  4643. ' *****************************************************************************
  4644. ' *  XMODEM UPLOAD DRIVER                                                     *
  4645. ' *****************************************************************************
  4646. '
  4647. 20540 IF USE.EXTERNAL.XMODEM THEN _
  4648.          GOTO 20261
  4649.       A1$ = "RECEIVE"
  4650.       GOSUB 20320
  4651.       OK = TRUE
  4652.       GOSUB 20860
  4653.       IF OK THEN _
  4654.          GOTO 20700
  4655.       GOTO 20730
  4656. '
  4657. ' *****************************************************************************
  4658. ' *  ASCII UPLOAD                                                             *
  4659. ' *****************************************************************************
  4660. '
  4661. 20560 CALL QTPUT("Transfer MUST end with a <Ctrl-K>",1)
  4662.       CALL QTPUT("ASCII RECEIVE of " + FILE.NAME.HOLD$ + " ready",1)
  4663.       OK = FALSE
  4664.       XOFF = FALSE
  4665.       CLOSE 2
  4666.       OPEN "O",2,FILE.NAME$
  4667.       GOSUB 20510
  4668. 20600 WHILE NOT EOF(3)
  4669.         CALL CARRIER
  4670.         IF SUBROUTINE.PARAMETER THEN _
  4671.            GOTO 10595
  4672.         IF LOF(3) < 512 THEN _
  4673.            PRINT #3,XOFF$; : _
  4674.            XOFF = TRUE
  4675. 20610   X$ = INPUT$(LOC(3),3)
  4676.         IF INSTR(X$,CHR$(11)) THEN _
  4677.            GOTO 20650
  4678.         OK = TRUE
  4679. 20620   PRINT #2,X$;
  4680.         IF SNOOP THEN _
  4681.            PRINT X$;
  4682. 20621   GOSUB 60000
  4683.         IF KEY.PRESSED$ = ESCAPE$ THEN _
  4684.            GOTO 20745
  4685.         IF NOT OK THEN _
  4686.            GOTO 20670
  4687. 20630 WEND
  4688.       CALL CARRIER
  4689.       IF SUBROUTINE.PARAMETER THEN _
  4690.          GOTO 10595
  4691.       IF XOFF THEN _
  4692.          XOFF = FALSE : _
  4693.          PRINT #3,XON$;
  4694.       GOTO 20600
  4695. 20650 X = INSTR(X$,CHR$(11))
  4696.       IF X <> 1 THEN _
  4697.          PRINT #2,LEFT$(X$,X-1) _
  4698.       ELSE IF NOT OK THEN _
  4699.               GOTO 20730
  4700.       GOTO 20700
  4701. 20670 A$ = XOFF$ + "System error! Upload aborted <Ctrl-K> continues"
  4702. 20675 GOSUB 12979
  4703.       CALL DELAYIT (3)
  4704.       CALL CARRIER
  4705.       IF SUBROUTINE.PARAMETER = 0 THEN _
  4706.          PRINT #3,XON$;
  4707. 20680 WHILE NOT EOF(3)
  4708.         X$ = INPUT$(LOC(3),3)
  4709.         IF INSTR(X$,CHR$(11)) THEN _
  4710.            GOTO 20730
  4711. 20685   CALL CARRIER
  4712.         IF SUBROUTINE.PARAMETER = -1 THEN _
  4713.            GOTO 10595
  4714.       WEND
  4715.       GOTO 20680
  4716. '
  4717. ' *****************************************************************************
  4718. ' *  UPDATE UPLOAD DIRECTORY                                                  *
  4719. ' *****************************************************************************
  4720. '
  4721. 20700 CALL UPDTUPLOAD (CATEGORY.NAME$(),CATEGORY.CODE$())
  4722.       IF BYTES.IN.FILE# > 0.0 THEN _
  4723.          GOTO 50610
  4724. 20730 CALL QTPUT ("Upload aborted",1)
  4725. 20735 CLOSE 2
  4726. 20736 KILL FILE.NAME$
  4727.       RETURN
  4728. '
  4729. ' *****************************************************************************
  4730. ' *  SYSOP ABORTED UPLOAD                                                     *
  4731. ' *****************************************************************************
  4732. '
  4733. 20745 A$ = XOFF$ + "SYSOP aborted upload. Stop tranfer. <Ctrl-K> continues"
  4734.       GOTO 20675
  4735. '
  4736. ' *****************************************************************************
  4737. ' *  CALCULATE DOWNLOAD TIME ESTIMATE                                         *
  4738. ' *****************************************************************************
  4739. '
  4740. 20750 CLOSE 2
  4741.       IF SHARE.IT THEN _
  4742.          OPEN FILE.NAME$ FOR RANDOM SHARED AS #2 _
  4743.       ELSE OPEN "R",2,FILE.NAME$,128
  4744. 20760 BYTES.IN.FILE# = LOF(2)
  4745.       IX# = FIX(BYTES.IN.FILE# / 128)
  4746.       BLOCKS.IN.FILE# = BYTES.IN.FILE# / 128
  4747.       IF IX# <> BLOCKS.IN.FILE# THEN _
  4748.          BLOCKS.IN.FILE# = BLOCKS.IN.FILE# + 1
  4749. 20780 A$ = "FILE SIZE: "
  4750.       IF FF = 4 OR FF = 8 THEN _
  4751.          GOTO 20785
  4752.       A$ = A$ + STR$(INT((BLOCKS.IN.FILE# / BLOCK.SIZE)+.5) + (-1*(FF>4))) + _
  4753.             " blocks "
  4754. 20785 A$ = A$ + STR$(BYTES.IN.FILE#) + " bytes"
  4755.       GOSUB 12979
  4756.       TLA = VAL(MID$("139165165165165142135165",3*FF-2,3))
  4757.       BLOCKS.IN.FILE# = BLOCKS.IN.FILE# * _
  4758.                         TLA / _
  4759.                         VAL(MID$("00030045120240480960",-3*BPS,3))
  4760.       IF BYTES.IN.FILE# < 1 THEN _
  4761.          RETURN 20792
  4762. 20790 SUBROUTINE.PARAMETER = 2
  4763.       CALL LINE25
  4764.       A$ = "Transfer time:" + _
  4765.          STR$(INT(BLOCKS.IN.FILE# / 60)) + " min," + _
  4766.          STR$(INT(BLOCKS.IN.FILE#-(INT(BLOCKS.IN.FILE#/60)*60))) + _
  4767.          " sec"
  4768.       GOSUB 12979
  4769.       GOSUB 41000
  4770.       IF (INT(BLOCKS.IN.FILE# / 60) + 1) > INT(TIME.REMAINING!) THEN _
  4771.          A$ = "Not enough time left!" : _
  4772.          CALL UPDTCALR (FILE.NAME$ + " " + A$,2) :_
  4773.          CALL QTPUT (A$,1): _
  4774.          A$ = "" : _
  4775.          RETURN 20792
  4776. 20792 RETURN
  4777. 20810 CALL CARRIER
  4778.       IF SUBROUTINE.PARAMETER = -1 THEN _
  4779.          GOTO 10595
  4780.       Y$ = ""
  4781.       CALL FINDTIME(DELAY!)
  4782.       DELAY! = DELAY! + 2
  4783. 20840 IF NOT EOF(3) THEN _
  4784.          Y$ = INPUT$(LOC(3),3) : _
  4785.          RETURN
  4786. 20850 CALL CHECKTIM (DELAY!)
  4787.       ON SUBROUTINE.PARAMETER GOTO 20840,20851
  4788. 20851 Y$ = ""
  4789.       RETURN
  4790. '
  4791. ' *****************************************************************************
  4792. ' *  XMODEM UPLOAD                                                            *
  4793. ' *****************************************************************************
  4794. '
  4795. 20860 GOSUB 20992
  4796.       IF NOT EIGHT.BIT THEN _
  4797.          GOSUB 21280
  4798. 20900 X$ = ""
  4799.       SEC = 1
  4800.       CLOSE 2
  4801.       OPEN "R",2,FILE.NAME$,128
  4802.       FIELD 2,128 AS Z$
  4803.       CALL CARRIER
  4804.       IF SUBROUTINE.PARAMETER = 0 THEN _
  4805.          PRINT #3,NEGATIVE.ACKNOWLEDGE$;
  4806.       CALL FINDTIME (TRANSFER.ABORT!)
  4807.       TRANSFER.ABORT! = TRANSFER.ABORT! + WAIT.BEFORE.DISCONNECT
  4808. 20920 FOR X = 1 TO 5
  4809.         GOSUB 60000
  4810.         IF KEY.PRESSED$ = ESCAPE$ THEN _
  4811.            GOTO 21270
  4812.         GOSUB 20810
  4813. 20930   IF LEFT$(Y$,1) = START.OF.HEADER$ THEN _
  4814.            GOTO 21020
  4815. 20940   IF LEFT$(Y$,1) = END.TRANSMISSION$ THEN _
  4816.            GOTO 21220
  4817. 20950   IF LEFT$(Y$,1) = CANCEL$ THEN _
  4818.            GOTO 21230
  4819. 20960   IF Y$ <> "" THEN _
  4820.            GOSUB 21280 : _
  4821.            CALL CHECKTIM (TRANSFER.ABORT!) : _
  4822.            ON SUBROUTINE.PARAMETER GOTO 20920,21230
  4823. 20970 NEXT
  4824.       CALL CARRIER
  4825.       IF SUBROUTINE.PARAMETER = 0 THEN _
  4826.          PRINT #3,NEGATIVE.ACKNOWLEDGE$;
  4827.       IF SNOOP THEN _
  4828.          PRINT "Upload Timeout"
  4829.       CALL CHECKTIM (TRANSFER.ABORT!)
  4830.       ON SUBROUTINE.PARAMETER GOTO 20990,21230
  4831. 20990 GOTO 20920
  4832. '
  4833. ' *****************************************************************************
  4834. ' *  CHANGE TO 8 BIT FOR XMODEM                                               *
  4835. ' *****************************************************************************
  4836. '
  4837. 20992 GOSUB 20510
  4838.       IF NOT EIGHT.BIT THEN _
  4839.          CALL DELAYIT (3) : _
  4840.          OUT LINE.CONTROL.REGISTER,3
  4841. 20996 SO = 0
  4842.       RETURN
  4843. '
  4844. ' *****************************************************************************
  4845. ' *  XMODEM UPLOAD                                                            *
  4846. ' *****************************************************************************
  4847. '
  4848. 21000 GOSUB 20810
  4849.       IF Y$ = "" THEN _
  4850.          PRINT "Upload Timeout" : _
  4851.          GOTO 21040
  4852. 21020 X$ = X$ + Y$
  4853.       IF LEN(X$) < SOL THEN _
  4854.          GOTO 21000
  4855. 21040 IF LEN(X$) = SOL THEN _
  4856.          GOTO 21090
  4857. 21050 IF LEN(X$) > SOL THEN _
  4858.          GOTO 21180
  4859. 21060 IF X$ = END.TRANSMISSION$ THEN _
  4860.          GOTO 21220
  4861. 21070 IF X$ = CANCEL$ THEN _
  4862.          GOTO 21230
  4863. 21080 GOTO 21170
  4864. 21090 IF SEC <> ASC(MID$(X$,2,1)) THEN _
  4865.          GOTO 21200
  4866. 21100 IF (SEC XOR 255) <> ASC(MID$(X$,3,1)) THEN _
  4867.          GOTO 21210
  4868. 21110 IF FT$ = "X" THEN _
  4869.          WK$ = MID$(X$,4,128): _
  4870.          GOSUB 46000 _
  4871.       ELSE WK$ = MID$(X$,4): _
  4872.            GOSUB 46000
  4873. 21112 IF FT$ = "X" THEN _
  4874.          IF XMODEM.CHECKSUM <> ASC(MID$(X$,132,1)) THEN _
  4875.             GOTO 21190 _
  4876.          ELSE GOTO 21120
  4877. 21113 IF CRC.VALUE <> 0 THEN _
  4878.          GOTO 21191
  4879. 21120 SO = SO + 1
  4880.       CALL CARRIER
  4881.       IF SUBROUTINE.PARAMETER = 0 THEN _
  4882.          PRINT #3,ACKNOWLEDGE$;
  4883. 21131 LSET Z$ = MID$(X$,4)
  4884.       PUT 2
  4885. 21145 SEC = 255 AND (SEC + 1)
  4886.       IF SNOOP THEN _
  4887.          LOCATE ,1 : _
  4888.          PRINT "OK Rec Blk #";SO;
  4889. 21150 X$=""
  4890.       XMODEM.CHECKSUM = 0
  4891.       CALL FINDTIME(TRANSFER.ABORT!)
  4892.       TRANSFER.ABORT! = TRANSFER.ABORT! + 30
  4893.       GOTO 20920
  4894. 21170 A$ = "Short Blk #"
  4895.       GOTO 21212
  4896. 21180 A$ = "Long Blk #"
  4897.       GOTO 21212
  4898. 21190 A$ = "Chksum Error #"
  4899.       GOTO 21212
  4900. 21191 A$="CRC Error": _
  4901.       GOTO 21212
  4902. 21200 A$ = "Blk # Error in #"
  4903.       IF SEC-1 <> ASC(MID$(X$,2,1)) THEN _
  4904.          GOTO 21212
  4905.       CALL CARRIER
  4906.       IF SUBROUTINE.PARAMETER = 0 THEN _
  4907.          PRINT #3,ACKNOWLEDGE$;
  4908.       GOTO 21150
  4909. 21210 A$ = "Complement Error in #"
  4910. 21212 CALL CARRIER
  4911.       IF SUBROUTINE.PARAMETER = 0 THEN _
  4912.          PRINT #3,NEGATIVE.ACKNOWLEDGE$;
  4913.       IF SNOOP THEN _
  4914.          PRINT LINE.FEED$;A$;SO + 1
  4915.       GOTO 21150
  4916. 21220 IF SNOOP THEN _
  4917.          PRINT LINE.FEED$;"File Closed"
  4918. 21225 CALL CARRIER
  4919.       IF SUBROUTINE.PARAMETER = 0 THEN _
  4920.          PRINT #3,ACKNOWLEDGE$;
  4921.       GOTO 21250
  4922. 21230 IF SNOOP THEN _
  4923.          PRINT LINE.FEED$;"Transfer Aborted"
  4924. 21240 OK = FALSE
  4925.       CALL CARRIER
  4926.       IF SUBROUTINE.PARAMETER = 0 THEN _
  4927.          PRINT #3,CANCEL$;CANCEL$;
  4928. 21250 EIGHT.BIT = TRUE
  4929.       RETURN
  4930. 21270 GOSUB 20510
  4931.       GOSUB 21280
  4932.       GOTO 21230
  4933. '
  4934. ' *****************************************************************************
  4935. ' *  CLEAR GARBAGE OUT OF COMMUNICATIONS BUFFER                               *
  4936. ' *****************************************************************************
  4937. '
  4938. 21280 IF EOF(3) THEN _
  4939.          RETURN
  4940.       CALL CARRIER
  4941.       IF SUBROUTINE.PARAMETER = -1 THEN _
  4942.          GOTO 10595
  4943. 21281 DF$ = INPUT$(LOC(3),3)
  4944.       GOTO 21280
  4945.       RETURN
  4946. '
  4947. ' *****************************************************************************
  4948. ' *  XMODEM DOWNLOAD                                                          *
  4949. ' *****************************************************************************
  4950. '
  4951. 21300 GOSUB 20992
  4952.       SEC = 0
  4953.       GOSUB 21280
  4954.       FIELD 2,128 AS X$
  4955.       NEGATIVE.ACKNOWLEDGE$=CHR$(21)
  4956.       CALL FINDTIME (TRANSFER.ABORT!)
  4957.       TRANSFER.ABORT! = TRANSFER.ABORT! + WAIT.BEFORE.DISCONNECT
  4958. 21350 WHILE NOT EOF(3)
  4959. 21360   Y$ = INPUT$(1,3)
  4960.         IF Y$ = CANCEL$ THEN _
  4961.            GOTO 21560
  4962. 21380   IF Y$ = NEGATIVE.ACKNOWLEDGE$ THEN _
  4963.            FF = 3: _
  4964.            FT$ = "X": _
  4965.            GOTO 21480 _
  4966.         ELSE IF Y$ = "C" THEN _
  4967.                 FF = 4: _
  4968.                 FT$ = "C": _
  4969.                 GOTO 21480
  4970. 21390 WEND
  4971.       GOSUB 21460
  4972.       CALL CHECKTIM (TRANSFER.ABORT!)
  4973.       ON SUBROUTINE.PARAMETER GOTO 21350,21455
  4974. 21410 CALL FINDTIME (TI!)
  4975.       TRANSFER.ABORT! = TI! + WAIT.BEFORE.DISCONNECT
  4976. 21415 WHILE NOT EOF(3)
  4977. 21420   Y$ = INPUT$(1,3)
  4978.         IF Y$ = ACKNOWLEDGE$ THEN _
  4979.            GOTO 21470
  4980. 21440   IF Y$ <> NEGATIVE.ACKNOWLEDGE$ THEN _
  4981.            GOTO 21450
  4982. 21443   IF SNOOP THEN _
  4983.            PRINT LINE.FEED$;"Error -> retrans #";SO
  4984. 21445   SO = SO-1
  4985.         GOTO 21490
  4986. 21450   IF Y$ = CANCEL$ THEN _
  4987.            GOTO 21560
  4988.         CALL CHECKTIM (TRANSFER.ABORT!)
  4989.         ON SUBROUTINE.PARAMETER GOTO 21451,21455
  4990. 21451 WEND
  4991.       GOSUB 21460
  4992.       CALL CHECKTIM (TRANSFER.ABORT!)
  4993.       ON SUBROUTINE.PARAMETER GOTO 21410,21455
  4994. 21455 IF SNOOP THEN _
  4995.          PRINT "Download timeout"
  4996.       GOTO 21560
  4997. 21460 CALL CARRIER
  4998.       IF SUBROUTINE.PARAMETER = -1 THEN _
  4999.          GOTO 10595
  5000.       GOSUB 60000
  5001.       IF KEY.PRESSED$ = ESCAPE$ THEN _
  5002.          RETURN 21540
  5003.       RETURN
  5004. 21470 IF SNOOP THEN _
  5005.          LOCATE ,1 : PRINT "OK Sent Blk #";SO;
  5006. 21480 IF LOC(2) < LOF(2) / 128 THEN _
  5007.          GET 2,(LOC(2) + 1) : _
  5008.          SEC = 255 AND (SEC + 1) : _
  5009.          GOTO 21490
  5010. 21485 GOTO 21530
  5011. 21490 SO = SO + 1
  5012.       CALL CARRIER
  5013.       IF SUBROUTINE.PARAMETER = 0 THEN _
  5014.          PRINT #3,START.OF.HEADER$; CHR$(SEC); CHR$(SEC XOR 255);X$;
  5015. 21503 WK$=X$
  5016. 21504 GOSUB 46000
  5017. 21510 CALL CARRIER
  5018.       IF FT$ = "X" AND SUBROUTINE.PARAMETER = 0 THEN _
  5019.          PRINT#3,CHR$(XMODEM.CHECKSUM); _
  5020.       ELSE IF SUBROUTINE.PARAMETER = 0 THEN _
  5021.               PRINT#3,CHR$(CRC.HIGH);CHR$(CRC.LOW);
  5022.       GOSUB 21280
  5023.       GOTO 21410
  5024. '
  5025. ' *****************************************************************************
  5026. ' *  END-OF-FILE FOR XMODEM DOWNLOADS -- SEND THE "EOT" CHARACTER AND WAIT UP *
  5027. ' *  TO 2 SECONDS FOR A POSITIVE RESPONSE (I.E. AN "ACK").  IF NONE IS        *
  5028. ' *  RE-TRY UP TO 10 TIMES.  IF NO POSITIVE RESPONSE IS RECEIVED AFTER TEN    *
  5029. ' *  ATTEMPTS, ASSUME THE DOWNLOAD WAS UNSUCCESSFULL.                         *
  5030. ' *****************************************************************************
  5031. '
  5032. 21530 CALL CARRIER
  5033.       IF SUBROUTINE.PARAMETER = 0 THEN _
  5034.          PRINT #3,END.TRANSMISSION$;
  5035.       FOR X = 1 TO 10
  5036.           GOSUB 20810
  5037.           IF INSTR(Y$,ACKNOWLEDGE$) THEN _
  5038.              GOTO 21550
  5039.           GOSUB 60000
  5040.           IF KEY.PRESSED$ = ESCAPE$ THEN _
  5041.              GOTO 21540
  5042. 21535 NEXT
  5043.       DOWNLOAD.COMPLETED = FALSE
  5044.       GOTO 21230
  5045. 21540 GOSUB 20510
  5046. 21545 Y$ = CANCEL$
  5047.       CALL CARRIER
  5048.       IF SUBROUTINE.PARAMETER = 0 THEN _
  5049.          PRINT #3,CANCEL$;CANCEL$;
  5050.       DOWNLOAD.COMPLETED = FALSE
  5051.       GOTO 21250
  5052. 21550 DOWNLOAD.COMPLETED = TRUE
  5053.       GOTO 21250
  5054. 21560 DOWNLOAD.COMPLETED = FALSE
  5055.       IF SNOOP THEN _
  5056.          PRINT LINE.FEED$;"Caller aborted trans"
  5057.       GOTO 21545
  5058. '
  5059. ' *****************************************************************************
  5060. ' *  MANUAL SELECT OF TRANSFER PROTOCOL                                       *
  5061. ' *****************************************************************************
  5062. '
  5063. 21600 CR = 0
  5064.       A$ = A$ + "Protocol:"
  5065.       GOSUB 12975
  5066.       A$ = TRANSFER.OPTIONS$
  5067.       GOSUB 12995
  5068.       IF Q = 0 THEN _
  5069.          GOTO 21600
  5070.       Z$ = B$(1)
  5071. '
  5072. ' *****************************************************************************
  5073. ' *  DEFAULT SELECT OF TRANSFER PROTOCOL                                      *
  5074. ' *****************************************************************************
  5075. '
  5076. 21610 CALL ALLCAPS (Z$)
  5077.       FF = INSTR("AXCKYIGWN",Z$)
  5078.       IF FF < 1 THEN _
  5079.          GOTO 21600
  5080.       IF FF = 4 AND NOT KERMIT.SUPPORT THEN _
  5081.          GOTO 21600
  5082.       IF (FF > 4 AND FF < 8) AND NOT XFER.SUPPORT THEN _
  5083.          GOTO 21600
  5084.       IF FF = 6 AND NOT RELIABLE.MODE THEN _
  5085.          GOTO 21600
  5086.       IF FF = 7 AND NOT RELIABLE.MODE THEN _
  5087.          GOTO 21600
  5088.       IF FF = 8 AND NOT WXMODEM.SUPPORT THEN _
  5089.          GOTO 21600
  5090.       FT$ = MID$("AXCKYIGW ",FF,1)
  5091.       RETURN
  5092. 21620 FF = -1
  5093.       IF COMMAND.TRANSFER$ <> "" THEN _
  5094.          Z$ = COMMAND.TRANSFER$ : _
  5095.          GOTO 21610
  5096.       IF USER.TRANSFER.DEFAULT$ > " " THEN _
  5097.          Z$ = USER.TRANSFER.DEFAULT$ : _
  5098.          GOTO 21610
  5099.       FF = 0
  5100.       RETURN
  5101. '
  5102. ' *****************************************************************************
  5103. ' *  GET MESSAGE HEADER RECORD DATA                                           *
  5104. ' *****************************************************************************
  5105. '
  5106. 23000 GET 1,1
  5107.       HIGH.MESSAGE.NUMBER = VAL(LEFT$(MESSAGE.RECORD$,8))
  5108.       CALLS.TODATE! = VAL(MID$(MESSAGE.RECORD$,11,10))
  5109.       CURRENT.USER.COUNT = VAL(MID$(MESSAGE.RECORD$,57,5))
  5110.       HIGHEST.USER.RECORD = VAL(MID$(MESSAGE.RECORD$,62,5))
  5111.       FIRST.MESSAGE.RECORD = VAL(MID$(MESSAGE.RECORD$,68,7))
  5112.       NEXT.MESSAGE.RECORD = VAL(MID$(MESSAGE.RECORD$,75,7))
  5113.       HIGHEST.MESSAGE.RECORD = VAL(MID$(MESSAGE.RECORD$,82,7))
  5114.       NODES.IN.SYSTEM = VAL(MID$(MESSAGE.RECORD$,127))
  5115.       IF NOT SYSOP AND NOT LOCAL.USER THEN _
  5116.          RETURN
  5117.       IF TEMP.SYSOP OR LOCAL.USER.MODE THEN _
  5118.          RETURN
  5119.       IF LAST.MESSAGE.READ < VAL(MID$(MESSAGE.RECORD$,123,4)) THEN _
  5120.          LAST.MESSAGE.READ = VAL(MID$(MESSAGE.RECORD$,123,4))
  5121.       LAST.MESSAGE.READ = - LAST.MESSAGE.READ * _
  5122.                       (LAST.MESSAGE.READ <= HIGH.MESSAGE.NUMBER)
  5123.       RETURN
  5124. '
  5125. '
  5126. ' *****************************************************************************
  5127. ' *  UPDATE MESSAGE HEADER RECORD DATA                                        *
  5128. ' *****************************************************************************
  5129. '
  5130. 24000 MID$(MESSAGE.RECORD$,1,8) = STR$(HIGH.MESSAGE.NUMBER)
  5131.       MID$(MESSAGE.RECORD$,11,10) = STR$(CALLS.TODATE!)
  5132.       MID$(MESSAGE.RECORD$,57,5) = STR$(CURRENT.USER.COUNT)
  5133.       MID$(MESSAGE.RECORD$,62,5) = STR$(HIGHEST.USER.RECORD)
  5134.       MID$(MESSAGE.RECORD$,68,7) = STR$(FIRST.MESSAGE.RECORD)
  5135.       MID$(MESSAGE.RECORD$,75,7) = STR$(NEXT.MESSAGE.RECORD)
  5136.       MID$(MESSAGE.RECORD$,82,7) = STR$(HIGHEST.MESSAGE.RECORD)
  5137.       PUT 1,1
  5138.       RETURN
  5139. '
  5140. ' *****************************************************************************
  5141. ' * F1 - COMMAND FROM LOCAL KEYBOARD (IMMEDIATE EXIT TO DOS)                  *
  5142. ' *****************************************************************************
  5143. '
  5144. 31000 FILE.NAME$ = LEFT$(CALLERS.FILE$,2) + _
  5145.                    "RBBS" + _
  5146.                    MID$("1234567890ABCDEFGHIJKLMNOPQRSTUVWXYZ", _
  5147.                       VAL(NODE.ID$),1) + _
  5148.                    "F1.DEF"
  5149.       CLOSE 2
  5150.       OPEN "O",2,FILE.NAME$
  5151.       PRINT #2,MID$(FILE.NAME$,3,7)
  5152.       IF EXIT.TO.DOORS THEN _
  5153.          SYSTEM
  5154.       GOSUB 14498                                                    ' CPC15-1B
  5155.       CALL DELAYIT (2)                                               ' CPC15-1B
  5156. 31005 CALL MLINIT (3)
  5157.       SYSTEM
  5158. '
  5159. ' *****************************************************************************
  5160. ' * F2 - COMMAND FROM LOCAL KEYBOARD (SYSOP EXIT TO DOS AND RETURN)           *
  5161. ' *****************************************************************************
  5162. '
  5163.  
  5164. 32000 IF NOT LOCAL.USER THEN _
  5165.          CALL QTPUT("Sysop exiting to DOS. Please wait...",1) : _
  5166.          FUNCTION.KEY = 0 : _
  5167.          CALL DELAYIT (3)
  5168.       SHELL DISK.FOR.DOS$+"COMMAND"
  5169.       CLS
  5170.       IF NOT LOCAL.USER THEN _
  5171.          CALL CARRIER : _
  5172.          IF SUBROUTINE.PARAMETER = -1 THEN _
  5173.             GOTO 10595 _
  5174.          ELSE SUBROUTINE.PARAMETER = 2 : _
  5175.               CALL LINE25 : _
  5176.               CALL QTPUT ("Sysop back from DOS.  Returning control to you.",2)
  5177.       RETURN
  5178. '
  5179. ' *****************************************************************************
  5180. ' * F3 - COMMAND FROM LOCAL KEYBOARD (PRINTER TOGGLE)                         *
  5181. ' *****************************************************************************
  5182. '
  5183. 33000 PRINTER = NOT PRINTER
  5184.       CHANGE.VALUE = PRINTER
  5185.       FIELD.POSITION = 38
  5186.       GOTO 33950
  5187. '
  5188. ' *****************************************************************************
  5189. ' * F4 - COMMAND FROM LOCAL KEYBOARD (SYSOP ANNOY)                            *
  5190. ' *****************************************************************************
  5191. '
  5192. 33040 SYSOP.ANNOY = NOT SYSOP.ANNOY
  5193.       CHANGE.VALUE = SYSOP.ANNOY
  5194.       FIELD.POSITION = 34
  5195.       GOTO 33950
  5196. '
  5197. ' *****************************************************************************
  5198. ' * F5 - COMMAND FROM LOCAL KEYBOARD (FORCE CALLER ONLINE)                    *
  5199. ' *****************************************************************************
  5200. '
  5201. 33060 FUNCTION.KEY = 0
  5202.       SUBROUTINE.PARAMETER = 4
  5203.       RETURN 200
  5204. '
  5205. ' *****************************************************************************
  5206. ' * F6 - COMMAND FROM LOCAL KEYBOARD (SYSOP AVAILABLE TOGGLE)                 *
  5207. ' *  6 - COMMAND FROM SYSOP MENU (SYSOP AVAILABLE TOGGLE)                     *
  5208. ' *****************************************************************************
  5209. '
  5210. 33070 SYSOP.AVAILABLE = NOT SYSOP.AVAILABLE
  5211.       CHANGE.VALUE = SYSOP.AVAILABLE
  5212.       FIELD.POSITION = 32
  5213.       GOTO 33950
  5214. '
  5215. ' *****************************************************************************
  5216. ' * F7 - COMMAND FROM LOCAL KEYBOARD (SYSOP GETS SYSTEM NEXT)                 *
  5217. ' *****************************************************************************
  5218. '
  5219. 33090 IF ERR=61 AND NOT DISKFULL.GO.OFFLINE THEN _
  5220.          RETURN
  5221.       SYSOP.NEXT = NOT SYSOP.NEXT
  5222.       CHANGE.VALUE = SYSOP.NEXT
  5223.       FIELD.POSITION = 36
  5224.       GOTO 33950
  5225. '
  5226. ' *****************************************************************************
  5227. ' * F8 - COMMAND FROM LOCAL KEYBOARD (ASSIGN USER TEMPORARY SYSOP SECURITY)   *
  5228. ' *****************************************************************************
  5229. '
  5230. 33110 SYSOP = NOT SYSOP
  5231.       CURSOR.LINE = CSRLIN
  5232.       CURSOR.ROW = POS(0)
  5233.       LOCATE 25,1
  5234.       PRINT SPACE$(79);
  5235.       LOCATE 25,1
  5236.       USER.SECURITY.LEVEL = (1 + SYSOP) * _
  5237.                             USER.SECURITY.SAVE  - _
  5238.                             SYSOP * _
  5239.                             SYSOP.SECURITY.LEVEL
  5240.       PRINT "Temp SYSOP Privileges "; MID$("OFFON",1-3*SYSOP,3);
  5241.       CALL DELAYIT (3)
  5242.       LOCATE CURSOR.LINE,CURSOR.ROW
  5243.       SUBROUTINE.PARAMETER = 1
  5244.       CALL LINE25
  5245.       CALL CALLOPT
  5246.       RETURN
  5247. '
  5248. ' *****************************************************************************
  5249. ' * F9 - COMMAND FROM LOCAL KEYBOARD (SNOOP TOGGLE)                           *
  5250. ' *****************************************************************************
  5251. '
  5252. 33130 IF NOT SNOOP THEN _
  5253.          SNOOP = TRUE : _
  5254.          LOCATE 24,1,0 : _
  5255.          PRINT "SNOOP ON"; : _
  5256.          SUBROUTINE.PARAMETER = 2 : _
  5257.          CALL LINE25 _
  5258.       ELSE LOCATE ,,0 : _
  5259.            SNOOP = FALSE : _
  5260.        CLS
  5261. 33140 CHANGE.VALUE = SNOOP
  5262.       FIELD.POSITION = 58
  5263.       GOTO 33950
  5264. '
  5265. ' *****************************************************************************
  5266. ' * F10 - COMMAND FROM LOCAL KEYBOARD (FORCE CHAT WITH USER)                  *
  5267. ' *****************************************************************************
  5268. '
  5269. 33150 IF CHAT.AVAILABLE = TRUE THEN _
  5270.          GOTO 33160
  5271.       CURSOR.LINE = CSRLIN
  5272.       CURSOR.ROW = POS(0)
  5273.       LOCATE 25,1
  5274.       PRINT SPACE$(79);
  5275.       LOCATE 25,1
  5276.       PRINT "CHAT not available now!";
  5277.       CALL DELAYIT (1)
  5278.       LOCATE CURSOR.LINE,CURSOR.ROW
  5279.       SUBROUTINE.PARAMETER = 1
  5280.       CALL LINE25
  5281.       RETURN
  5282. 33160 CALL UPDTCALR ("Sysop began chat",1)
  5283.       CALL SKIPLINE (1)
  5284.       CALL QTPUT ("Hi " + _
  5285.            FIRST.NAME$ + _
  5286.            ", this is " + _
  5287.            SYSOP.FIRST.NAME$ + _
  5288.            " " + _
  5289.            SYSOP.LAST.NAME$ + _
  5290.            "  Sorry to break in to CHAT but..",1)
  5291.       FUNCTION.KEY = 0
  5292.       GOTO 4770
  5293. '
  5294. ' *****************************************************************************
  5295. ' * PGUP DISPLAY USER PROFILE                                                 *
  5296. ' *****************************************************************************
  5297. '
  5298. 33200 CALL CARRIER
  5299.       IF SUBROUTINE.PARAMETER = -1 THEN _
  5300.          RETURN
  5301.       USER.DATA = TRUE
  5302.       PRINT
  5303.       PRINT "USER NAME: ";ACTIVE.USER.NAME$
  5304.       PRINT "SECURITY :";STR$(USER.SECURITY.SAVE)
  5305.       PRINT "PASSWORD :";PASSWORD.SAVE$
  5306.       PRINT "READ MSG.:";STR$(LAST.MESSAGE.READ)
  5307.       PRINT "TIMES ON :";STR$(TIMES.LOGGED.ON)
  5308.       PRINT "LAST ON  :";LAST.DATE.TIME.ON.SAVE$
  5309.       PRINT "DOWNLOADS:";STR$(DOWNLOADS)
  5310.       PRINT "UPLOADS  :";STR$(UPLOADS)
  5311.       PRINT "User's Profile"
  5312.       GOSUB 5410
  5313.       USER.DATA = FALSE
  5314.       RETURN
  5315. '
  5316. ' *****************************************************************************
  5317. ' * UPDATE NODE RECORD WITH LOCAL FUNCTION KEY ACTIVITY                       *
  5318. ' *****************************************************************************
  5319. '
  5320. 33950 IF SNOOP THEN _
  5321.          SUBROUTINE.PARAMETER = 1 : _
  5322.          CALL LINE25
  5323. 33960 IF CONFERENCE.MODE = FALSE THEN _
  5324.          GOSUB 12986 : _
  5325.          CALL OPENMSG : _
  5326.          IF EC = 64 THEN _
  5327.             EC = 0 : _
  5328.             GOTO 5360 _
  5329.          ELSE FIELD 1, 128 AS MESSAGE.RECORD$ : _
  5330.          GET 1,NODE.RECORD.INDEX : _
  5331.          MID$(MESSAGE.RECORD$,FIELD.POSITION,2) = STR$(CHANGE.VALUE) : _
  5332.          CALL SAVEPROF (2) : _
  5333.          FIELD 1, 128 AS MESSAGE.RECORD$ : _
  5334.          RETURN
  5335. 33970 PRINT "Cannot change status during Conference!"
  5336.       RETURN
  5337. '
  5338. ' *****************************************************************************
  5339. ' * CALCULATE TIME REMAINING FOR USER                                         *
  5340. ' *****************************************************************************
  5341. '
  5342. 41000 CALL TIMEREMAIN (TIME.REMAINING!)
  5343.       IF BYPASS.TIME.CHECK THEN _
  5344.          RETURN
  5345.       IF TIME.REMAINING! < 0.1 THEN _
  5346.          RETURN 10553
  5347.       RETURN
  5348. '
  5349. ' *****************************************************************************
  5350. ' * SHOW USER CURRENT ACCESS LEVEL                                            *
  5351. ' *****************************************************************************
  5352. '
  5353. 41070 A$ = "Granted access level" + _
  5354.            STR$(USER.SECURITY.LEVEL) + _
  5355.            MID$(" (SYSOP)",1,-8*(USER.SECURITY.LEVEL >= SYSOP.SECURITY.LEVEL))
  5356.       GOSUB 12975
  5357.       RETURN
  5358. '
  5359. ' *****************************************************************************
  5360. ' * NULLS SET FOR NEW USERS                                                   *
  5361. ' *****************************************************************************
  5362. '
  5363. 42700 A$ = "Want nulls (for printing terminal) (Y/N)"
  5364.       GOSUB 12995
  5365.       IF NO OR YES THEN _
  5366.          NULLS = NO _
  5367.       ELSE GOTO 42700
  5368. '
  5369. ' *****************************************************************************
  5370. ' *  N - COMMAND FROM UTILITY MENU (NULLS TOGGLE)                             *
  5371. ' *****************************************************************************
  5372. '
  5373. 42710 NULLS = NOT NULLS
  5374.       GOSUB 9520
  5375. 42720 A$ = "Nulls " + MID$("OffOn",1-3*NULLS,3)
  5376.       GOSUB 12979
  5377.       RETURN
  5378. '
  5379. ' *****************************************************************************
  5380. ' *  F - COMMAND FROM UTILITY MENU (FILE TRANSFER DEFALUT MODE)               *
  5381. ' *  FILE TRANSFER DEFAULT SET FOR NEW USERS                                  *
  5382. ' *****************************************************************************
  5383. '
  5384. 42800 A$ = "Default "
  5385.       GOSUB 21600
  5386.       USER.TRANSFER.DEFAULT$ = FT$
  5387. 42810 A$ = "PROTOCOL: " + _
  5388.            MID$("Ascii  Xmodem Xm/CRC Kermit Ymodem Imodem YmodemGWxmodemNone",7*FF-6,7)
  5389.       GOSUB 12979
  5390.       RETURN
  5391. '
  5392. ' *****************************************************************************
  5393. ' *  C - COMMAND FROM UTILITY MENU (CHANGE CASE TOGGLE)                       *
  5394. ' *  UPPER/LOWER CASE SET FOR NEW USERS                                       *
  5395. ' *****************************************************************************
  5396. '
  5397. 42950 A$ = "CAN YOUR TERMINAL DISPLAY LOWER CASE (Y/N)"
  5398.       GOSUB 12995
  5399.       IF NO OR YES THEN _
  5400.          UPPER.CASE = YES _
  5401.       ELSE GOTO 42950
  5402. 42960 UPPER.CASE = NOT UPPER.CASE
  5403.       A$ = "UPPER CASE " + MID$("and lowerONLY",1-9*UPPER.CASE,9)
  5404.       GOSUB 12979
  5405.       RETURN
  5406. '
  5407. ' *****************************************************************************
  5408. ' *  G - COMMAND FROM UTILITY MENU (GRAPHICS WANTED)                          *
  5409. ' *  GRAPHIC MENUS SELECTION SET FOR NEW USERS                                *
  5410. ' *****************************************************************************
  5411. '
  5412. 43000 IF NOT EIGHT.BIT THEN _
  5413.          CALL QTPUT("Graphics unavailable",1):_
  5414.          RETURN
  5415. 43005 IF EXPERT.USER THEN _
  5416.          GOTO 43007
  5417. 43006 FILE.NAME$ = HELP$(9)
  5418.       CALL BUFFILE (FILE.NAME$)
  5419.       CALL CARRIER
  5420.       IF SUBROUTINE.PARAMETER = -1 THEN _
  5421.          GOTO 10595
  5422. 43007 A$ = "GRAPHICS wanted: N)one, A)scii-IBM, C)olor-IBM, H)elp"
  5423.       GOSUB 12995
  5424.       IF Q = 0 THEN _
  5425.          GOTO 43007
  5426.       CALL ALLCAPSD (B$(),1)
  5427.       GR = INSTR("NAC",B$(1))
  5428.       IF GR = 0 THEN _
  5429.          GOTO 43006
  5430.       USER.GRAPHIC.DEFAULT$ = MID$(" GC",GR,-(GR > 1))
  5431.       GR = GR-1
  5432. 43020 A$ = "GRAPHICS: " + MID$("None AsciiColor",GR*5 + 1,5)
  5433.       GOSUB 12979
  5434.       RETURN
  5435. 43025 GOSUB 43030
  5436. '
  5437. ' *****************************************************************************
  5438. ' *  DISPLAY NON-BREAKABLE TEXT FILES                                         *
  5439. ' *****************************************************************************
  5440. '
  5441. 43027 STOP.INTERRUPTS = FALSE
  5442.       CALL BUFFILE (FILE.NAME$)
  5443.       CALL CARRIER
  5444.       IF SUBROUTINE.PARAMETER = -1 THEN _
  5445.          RETURN 10595
  5446.       STOP.INTERRUPTS = TRUE
  5447.       RETURN
  5448. 43030 CALL GRAPHIC (USER.GRAPHIC.DEFAULT$)
  5449.       RETURN
  5450. '
  5451. ' *****************************************************************************
  5452. ' * MAKE INPUT STRING HIDDEN (USE *'S TO ECHO INPUT)                          *
  5453. ' *****************************************************************************
  5454. '
  5455. 45010 HIDDEN = TRUE
  5456.       GOSUB 12995
  5457.       HIDDEN = FALSE
  5458.       GOSUB 12979
  5459.       RETURN
  5460. '
  5461. ' *****************************************************************************
  5462. ' *  XMODEM / CRC INTERFACE                                                   *
  5463. ' *****************************************************************************
  5464. '
  5465. 46000 XMODEM.CHECKSUM = 0
  5466.       CRC.VALUE = 0
  5467.       CALL XMODEM(WK$,XMODEM.CHECKSUM,CRC.VALUE,CRC.HIGH,CRC.LOW)
  5468.       RETURN
  5469. '
  5470. ' *****************************************************************************
  5471. ' *  DISPLAY MESSAGE & COMMENT EDIT PROMPT LINE                               *
  5472. ' *****************************************************************************
  5473. '
  5474. 50400 A$ = "A)bort, C)ontinue, D)elete, E)dit, I)nsert, L)ist, M)argin, S)ave"
  5475.       GOSUB 12975
  5476.       RETURN
  5477. '
  5478. ' *****************************************************************************
  5479. ' * UPDATE DOWNLOAD STATISTICS                                                *
  5480. ' *****************************************************************************
  5481. '
  5482. 50600 IF DOWNLOAD.COMPLETED THEN _
  5483.          CALL QTPUT ("Download successful",1):_
  5484.          DOWNLOADS = DOWNLOADS + 1 : _
  5485.          CALL MUSIC (6) : _
  5486.          Y$ = " Downloaded " _
  5487.       ELSE Y$ = " Aborted "
  5488.       IF AUTODOWNLOAD.IN.PROGRESS THEN _
  5489.          Y$ = " AUTO" + _
  5490.               MID$(Y$,2)
  5491.       IF INSTR(Y$,"Aborted") THEN _
  5492.          AUTODOWNLOAD.IN.PROGRESS = 0
  5493.       A$ = ""
  5494. 50610 IF LOCAL.USER THEN _
  5495.          RETURN
  5496.       SUBROUTINE.PARAMETER = 2
  5497.       CALL AMORPM
  5498.       CALL BRKFNAME (FILE.NAME$,DR$,X$,EXTENTION$,TRUE)
  5499.       Z$ = X$ + EXTENTION$ + Y$ + "at " + TIM$ + _
  5500.            " using " + FT$ + STR$(BYTES.IN.FILE#)
  5501.        CALL UPDTCALR (Z$,2)
  5502.       RETURN
  5503. '
  5504. ' *****************************************************************************
  5505. ' *   DIRECTORY SEARCH                                                        *
  5506. ' *****************************************************************************
  5507. '
  5508. 52900 CK = 2
  5509.       IF Q > 1 THEN _
  5510.          GOTO 52920
  5511. 52910 A$ = "Search for string"
  5512.       GOSUB 12998
  5513.       IF Q = 0 THEN _
  5514.          RETURN
  5515.       B$(2) = B$(1)
  5516. 52920 CALL ALLCAPSD (B$(),2)
  5517.       RS$ = B$(2)
  5518.       SEARCH.STRING$ = RS$
  5519.       A1$ = B$(2)
  5520.       GOTO 53007
  5521. '
  5522. ' *****************************************************************************
  5523. ' *  N - COMMAND FROM FILES MENU (DISPLAY NEW FILES SINCE LAST DIR DISPLAY)   *
  5524. ' *****************************************************************************
  5525. '
  5526. 53000 CK = 1
  5527.       IF Q > 1 THEN _
  5528.          GOTO 53005
  5529. 53002 A1$ = RIGHT$(LM$,4) + LEFT$(LM$,2)
  5530.       A$ = "Files on/after (MMDDYY, [ENTER] = last on " + A1$ + ")"
  5531.       GOSUB 12995
  5532.       IF Q = 0 THEN _
  5533.          RS$ = LM$ : _
  5534.          GOTO 53006
  5535.       B$(2) = B$(1)
  5536. 53005 IF LEN(B$(2)) <> 6 THEN _
  5537.          GOTO 53002
  5538.       A1$ = B$(2)
  5539.       RS$ = RIGHT$(A1$,2) + LEFT$(A1$,4)
  5540. 53006 SEARCH.DATE$ = RS$
  5541.       SEARCH.STRING$ = ""
  5542. 53007 IF Q > 2 THEN _
  5543.          DIR.INDEX = 3 : _
  5544.          GOTO 53030
  5545. 53010 CALL GETDIRS ("quits")
  5546.       IF Q = 0 THEN _
  5547.          RETURN
  5548.       DIR.INDEX = 1
  5549. 53030 CALL CONVDIRS (DIR.INDEX)
  5550.       LAST.DIR.POS = Q
  5551.       LIST.DIRECTORY = TRUE
  5552.       LIST.NEW = TRUE
  5553. 53035 Z$ = B$(DIR.INDEX)
  5554.       IF Z$ = "ALL" THEN _
  5555.          IF NOT LIMIT.SEARCH.TO.FMS THEN _
  5556.             GOTO 53070
  5557. 53060 LIST.INDEX = DIR.INDEX
  5558.       QX = LIST.INDEX
  5559.       GOSUB 20161
  5560.       DIR.INDEX = DIR.INDEX + 1
  5561.       IF DIR.INDEX <= LAST.DIR.POS THEN _
  5562.          GOTO 53035
  5563.       LIST.NEW = FALSE
  5564.       SEARCH.STRING$ = ""
  5565.       SEARCH.DATE$ = ""
  5566.       RETURN
  5567. 53070 G = DIR.INDEX
  5568.       J = DIR.INDEX
  5569.       B$(DIR.INDEX) = DIRECTORY.PATH$ + _
  5570.                 "*." + _
  5571.                 DIRECTORY.EXTENTION$
  5572.       GOSUB 53100
  5573.       CLS
  5574.       SUBROUTINE.PARAMETER = 1
  5575.       CALL LINE25
  5576.       QX = G
  5577.       LIST.INDEX = DIR.INDEX+1
  5578.       GOSUB 20161
  5579.       LIST.NEW = FALSE
  5580.       REDIM B$(ADIM)
  5581.       RETURN
  5582. 53100 CLS
  5583. 53101 FILES B$(J)
  5584.       X = CSRLIN
  5585.       LOCATE 2,1,1
  5586.       MAIN.DIRECTORY$ = DIRECTORY.EXTENTION$
  5587.       FOR I = 2 TO X
  5588.         FOR B = 1 TO 66 STEP 18
  5589.           G = G + 1
  5590.           B$(G) = ""
  5591.           FOR QQ = 0 TO 7
  5592.             H = SCREEN (I,(B + QQ))
  5593.             B$(G) = B$(G) + CHR$(H)
  5594.           NEXT
  5595.           IF LEFT$(B$(G),1) = " " THEN _
  5596.              G = G-1 : _
  5597.              RETURN
  5598.           WHILE RIGHT$(B$(G),1) = " "
  5599.                 B$(G) = LEFT$(B$(G),LEN(B$(G))-1)
  5600.           WEND
  5601. 53105     IF LIST.NEW THEN _
  5602.          IF (OMIT.MAIN.DIRECTORY$ = "YES" AND _
  5603.                  (B$(G) = MAIN.DIRECTORY$ OR _
  5604.                   B$(G) = MAIN.DIRECTORY$ + "G" OR _
  5605.                   B$(G) = MAIN.DIRECTORY$ + "C")) OR _
  5606.         (USER.SECURITY.LEVEL < MIN.SEC.TO.VIEW AND _
  5607.                  (B$(G) = UPLOAD.DIR.CHECK$ OR _
  5608.                   B$(G) = UPLOAD.DIR.CHECK$ + "G" OR _
  5609.           B$(G) = UPLOAD.DIR.CHECKS$ + "C")) THEN _
  5610.                     G = G-1 : _
  5611.                     GOTO 53110
  5612. 53110   NEXT
  5613.       NEXT
  5614.       RETURN
  5615.  
  5616. '
  5617. ' *****************************************************************************
  5618. ' *  DISPLAY CALLERS FILE                                                     *
  5619. ' *****************************************************************************
  5620. '
  5621. 57000 CALL SKIPLINE (1)
  5622.       CALLERS.FILE.INDEX.TEMP = CALLERS.FILE.INDEX
  5623.       CLOSE 4
  5624.       OPEN "R",4,CALLERS.FILE$,64
  5625.       FIELD 4,64 AS CALLERS.RECORD$
  5626. 57005 IF CALLERS.FILE.INDEX.TEMP  < 1 OR _
  5627.          RET THEN _
  5628.          RETURN
  5629. 57010 GET 4,CALLERS.FILE.INDEX.TEMP
  5630.       A$ = CALLERS.RECORD$
  5631.       IF LEFT$(A$,3) = SPACE$(3) OR _
  5632.          INSTR(A$,"on at") = 0 THEN _
  5633.          GOTO 57030
  5634. 57025 CALLERS.FILE.INDEX.TEMP = CALLERS.FILE.INDEX.TEMP - 1
  5635.       GET 4,CALLERS.FILE.INDEX.TEMP
  5636.       Z = INSTR(CALLERS.RECORD$,"{")
  5637.       IF Z < 1 OR Z > 15 THEN _
  5638.          Z = 15
  5639.       IF SYSOP OR _
  5640.          LEFT$(A1$,3) <> "   " THEN _
  5641.          A$ = A$ + LEFT$(CALLERS.RECORD$,Z-1)
  5642.       GOSUB 57100
  5643.       IF SYSOP THEN _
  5644.          A$ = MID$(CALLERS.RECORD$,Z) : _
  5645.          GOSUB 57100
  5646.       GOTO 57045
  5647. 57030 IF SYSOP THEN _
  5648.          GOSUB 57100
  5649. 57045 CALLERS.FILE.INDEX.TEMP = CALLERS.FILE.INDEX.TEMP -1
  5650.       GOTO 57005
  5651. 57100 CALL QTPUT (A$,1)
  5652. 57110 IF LINES.PRINTED >= PAGE.LENGTH THEN _
  5653.          IF NON.STOP THEN _
  5654.             LINES.PRINTED = 0 : _
  5655.             CALL CARRIER : _
  5656.             IF SUBROUTINE.PARAMETER THEN _
  5657.                RETURN 10595 _
  5658.             ELSE _
  5659.                RETURN _
  5660.          ELSE _
  5661.             GOSUB 5600 : _
  5662.          IF NO THEN _
  5663.             RETURN 57120
  5664. 57120 RETURN
  5665. '
  5666. ' *****************************************************************************
  5667. ' *  TEST FOR FUNCTION KEY PRESSED                                            *
  5668. ' *****************************************************************************
  5669. '
  5670. 60000 CALL FINDFUNC
  5671. 60010 IF LEN(KEY.PRESSED$) <> 2 THEN _
  5672.          RETURN
  5673.       ON FUNCTION.KEY GOSUB 31000, _            ' F1
  5674.                             32000, _            ' F2
  5675.                             33000, _            ' F3
  5676.                             33040, _            ' F4
  5677.                             33060, _            ' F5
  5678.                             33070, _            ' F6
  5679.                             33090, _            ' F7
  5680.                             33110, _            ' F8
  5681.                             33130, _            ' F9
  5682.                             33150, _            ' F10
  5683.                             1398, _             ' END KEY
  5684.                 33200               ' PGUP
  5685.       KEY.PRESSED$ = ""
  5686.       RETURN
  5687. '
  5688. ' *****************************************************************************
  5689. ' *  REPLY TO MESSAGE SAVE ORIGINAL ATTRIBUTES                                *
  5690. ' *****************************************************************************
  5691. '
  5692. 62520 SQ = Q
  5693.       LG$(10) = B$
  5694.       LINES.IN.MESSAGE.SAVE = LINES.IN.MESSAGE
  5695.       SL = S
  5696.       NON.STOP.SAVE = NON.STOP
  5697.       MESSAGE.DIM.INDEX.SAVE = MESSAGE.DIM.INDEX
  5698.       RETURN
  5699. '
  5700. ' *****************************************************************************
  5701. ' *  REPLY TO MESSAGE RESTORE ORIGINAL ATTRIBUTES                             *
  5702. ' *****************************************************************************
  5703. '
  5704. 62530 Q = SQ
  5705.       B$ = LG$(10)
  5706.       LINES.IN.MESSAGE = LINES.IN.MESSAGE.SAVE
  5707.       S = SL
  5708.       NON.STOP = NON.STOP.SAVE
  5709.       MESSAGE.DIM.INDEX = MESSAGE.DIM.INDEX.SAVE
  5710.       KILL.MESSAGE = FALSE
  5711.       RETURN
  5712. '
  5713. ' *****************************************************************************
  5714. ' *  TEST FOR EXIT TO DOS                                                     *
  5715. ' *****************************************************************************
  5716. '
  5717. 63000 OLD.DAT$ = MID$(MESSAGE.RECORD$,76,10)
  5718.       OLD.TIME = VAL(MID$(MESSAGE.RECORD$,86,5))
  5719.       NEW.TIME = VAL(LEFT$(TIME$,2)) * 100 + VAL(MID$(TIME$,4,2))
  5720.       IF OLD.DAT$ = DATE$ THEN _
  5721.          RETURN
  5722.       IF NEW.TIME < OLD.TIME THEN _
  5723.          RETURN
  5724.       MID$(MESSAGE.RECORD$,76,10) = DATE$
  5725.       MID$(MESSAGE.RECORD$,86,5) = STR$(TIME.TO.DROP.TO.DOS)
  5726.       PUT 1,NODE.RECORD.INDEX                                        ' CPC15-1B
  5727.       SHELL "RBBSTIME"
  5728.       RETURN
  5729.